hspec-api-2.11.9/0000755000000000000000000000000007346545000011646 5ustar0000000000000000hspec-api-2.11.9/LICENSE0000644000000000000000000000206707346545000012660 0ustar0000000000000000Copyright (c) 2022-2024 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hspec-api-2.11.9/Setup.lhs0000644000000000000000000000011407346545000013452 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-api-2.11.9/hspec-api.cabal0000644000000000000000000000342107346545000014503 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hspec-api version: 2.11.9 synopsis: A Testing Framework for Haskell description: This package provides a stable API that can be used to extend Hspec's functionality. category: Testing stability: stable homepage: https://hspec.github.io/ bug-reports: https://github.com/hspec/hspec/issues author: Simon Hengel maintainer: Simon Hengel copyright: (c) 2022-2024 Simon Hengel license: MIT license-file: LICENSE build-type: Simple extra-source-files: version.yaml source-repository head type: git location: https://github.com/hspec/hspec subdir: hspec-api library exposed-modules: Test.Hspec.Api.Format.V1 Test.Hspec.Api.Format.V2 Test.Hspec.Api.Formatters.V1 Test.Hspec.Api.Formatters.V2 Test.Hspec.Api.Formatters.V3 other-modules: Test.Hspec.Api.Format.V1.Internal Test.Hspec.Api.Format.V2.Config hs-source-dirs: src ghc-options: -Wall build-depends: base ==4.* , hspec-core ==2.11.9 , transformers default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Test.Hspec.Api.Format.V1Spec Test.Hspec.Api.Format.V2Spec Test.Hspec.Api.Formatters.V1Spec Test.Hspec.Api.Formatters.V2Spec Test.Hspec.Api.Formatters.V3Spec Paths_hspec_api hs-source-dirs: test ghc-options: -Wall build-tool-depends: hspec-discover:hspec-discover build-depends: base ==4.* , hspec ==2.* , hspec-api , hspec-core ==2.11.9 , transformers default-language: Haskell2010 hspec-api-2.11.9/src/Test/Hspec/Api/Format/0000755000000000000000000000000007346545000016357 5ustar0000000000000000hspec-api-2.11.9/src/Test/Hspec/Api/Format/V1.hs0000644000000000000000000001075507346545000017211 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} -- | -- Stability: stable module Test.Hspec.Api.Format.V1 ( Format , FormatConfig(..) , Event(..) , Progress , Path , Location(..) , Seconds(..) , Item(..) , Result(..) , FailureReason(..) , monadic -- * Register a formatter , registerFormatter , useFormatter , liftFormatter -- * Re-exports , SpecWith , Config , modifyConfig ) where import qualified Test.Hspec.Core.Format as Latest import qualified Test.Hspec.Api.Format.V2 as V2 import Test.Hspec.Api.Format.V2 hiding ( registerFormatter , useFormatter , liftFormatter , FormatConfig(..) , Item(..) , FailureReason(..) , Result(..) , Event(..) , Format , monadic ) import Control.Monad.IO.Class import Test.Hspec.Api.Format.V1.Internal -- | -- Make a formatter available for use with @--format@. registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config registerFormatter = V2.registerFormatter . liftFormatterToV2 -- | -- Make a formatter available for use with @--format@ and use it by default. useFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config useFormatter = V2.useFormatter . liftFormatterToV2 -- | Make a formatter compatible with types from "Test.Hspec.Core.Format". liftFormatter :: (String, FormatConfig -> IO Format) -> (String, Latest.FormatConfig -> IO Latest.Format) liftFormatter = V2.liftFormatter . liftFormatterToV2 liftFormatterToV2 :: (String, FormatConfig -> IO Format) -> (String, V2.FormatConfig -> IO V2.Format) liftFormatterToV2 = fmap lift where lift :: (FormatConfig -> IO Format) -> V2.FormatConfig -> IO V2.Format lift format = fmap liftFormat . format . unliftFormatConfig data FormatConfig = FormatConfig { formatConfigUseColor :: Bool , formatConfigReportProgress :: Bool , formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool , formatConfigDiffContext :: Maybe Int , formatConfigExternalDiff :: Maybe (String -> String -> IO ()) , formatConfigPrettyPrint :: Bool -- ^ Deprecated: use `formatConfigPrettyPrintFunction` instead , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String)) , formatConfigPrintTimes :: Bool , formatConfigHtmlOutput :: Bool , formatConfigPrintCpuTime :: Bool , formatConfigUsedSeed :: Integer , formatConfigExpectedTotalCount :: Int } unliftFormatConfig :: V2.FormatConfig -> FormatConfig unliftFormatConfig config = FormatConfig { formatConfigUseColor = V2.formatConfigUseColor config , formatConfigReportProgress = V2.formatConfigReportProgress config , formatConfigOutputUnicode = V2.formatConfigOutputUnicode config , formatConfigUseDiff = V2.formatConfigUseDiff config , formatConfigDiffContext = V2.formatConfigDiffContext config , formatConfigExternalDiff = V2.formatConfigExternalDiff config , formatConfigPrettyPrint = maybe False (const True) $ V2.formatConfigPrettyPrintFunction config , formatConfigPrettyPrintFunction = V2.formatConfigPrettyPrintFunction config , formatConfigPrintTimes = V2.formatConfigPrintTimes config , formatConfigHtmlOutput = V2.formatConfigHtmlOutput config , formatConfigPrintCpuTime = V2.formatConfigPrintCpuTime config , formatConfigUsedSeed = V2.formatConfigUsedSeed config , formatConfigExpectedTotalCount = V2.formatConfigExpectedTotalCount config } type Format = Event -> IO () liftFormat :: Format -> V2.Format liftFormat format event = format (unliftEvent event) unliftFormat :: V2.Format -> Format unliftFormat format event = format (liftEvent event) data Event = Started | GroupStarted Path | GroupDone Path | Progress Path Progress | ItemStarted Path | ItemDone Path Item | Done [(Path, Item)] deriving Show liftEvent :: Event -> V2.Event liftEvent = \ case Started -> V2.Started GroupStarted path -> V2.GroupStarted path GroupDone path -> V2.GroupDone path Progress path progress -> V2.Progress path progress ItemStarted path -> V2.ItemStarted path ItemDone path item -> V2.ItemDone path (liftItem item) Done result -> V2.Done (map (fmap liftItem) result) unliftEvent :: V2.Event -> Event unliftEvent = \ case V2.Started -> Started V2.GroupStarted path -> GroupStarted path V2.GroupDone path -> GroupDone path V2.Progress path progress -> Progress path progress V2.ItemStarted path -> ItemStarted path V2.ItemDone path item -> ItemDone path (unliftItem item) V2.Done result -> Done (map (fmap unliftItem) result) monadic :: MonadIO m => (m () -> IO ()) -> (Event -> m ()) -> IO Format monadic run format = unliftFormat <$> V2.monadic run (format . unliftEvent) hspec-api-2.11.9/src/Test/Hspec/Api/Format/V1/0000755000000000000000000000000007346545000016645 5ustar0000000000000000hspec-api-2.11.9/src/Test/Hspec/Api/Format/V1/Internal.hs0000644000000000000000000000376407346545000020767 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} module Test.Hspec.Api.Format.V1.Internal ( FailureReason(..) , module Test.Hspec.Api.Format.V1.Internal ) where import Test.Hspec.Core.Util (stripAnsi) import Test.Hspec.Core.Formatters.V1 (FailureReason(..)) import qualified Test.Hspec.Api.Format.V2 as V2 import Test.Hspec.Api.Format.V2 hiding (Item(..), Result(..), FailureReason(..)) data Item = Item { itemLocation :: Maybe Location , itemDuration :: Seconds , itemInfo :: String , itemResult :: Result } deriving Show data Result = Success | Pending (Maybe Location) (Maybe String) | Failure (Maybe Location) FailureReason deriving Show liftItem :: Item -> V2.Item liftItem Item{..} = V2.Item { itemLocation , itemDuration , itemInfo , itemResult = liftResult itemResult } unliftItem :: V2.Item -> Item unliftItem V2.Item{..} = Item { itemLocation , itemDuration , itemInfo , itemResult = unliftResult itemResult } liftResult :: Result -> V2.Result liftResult = \ case Success -> V2.Success Pending loc reason -> V2.Pending loc reason Failure loc reason -> V2.Failure loc (liftFailureReson reason) unliftResult :: V2.Result -> Result unliftResult = \ case V2.Success -> Success V2.Pending loc reason -> Pending loc reason V2.Failure loc reason -> Failure loc (unliftFailureReason reason) liftFailureReson :: FailureReason -> V2.FailureReason liftFailureReson = \ case NoReason -> V2.NoReason Reason reason -> V2.Reason reason ExpectedButGot preface expected actual -> V2.ExpectedButGot preface expected actual Error info e -> V2.Error info e unliftFailureReason :: V2.FailureReason -> FailureReason unliftFailureReason = \ case V2.NoReason -> NoReason V2.Reason reason -> Reason reason V2.ColorizedReason reason -> Reason (stripAnsi reason) V2.ExpectedButGot preface expected actual -> ExpectedButGot preface expected actual V2.Error info e -> Error info e hspec-api-2.11.9/src/Test/Hspec/Api/Format/V2.hs0000644000000000000000000000337707346545000017214 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} -- | -- Stability: stable module Test.Hspec.Api.Format.V2 ( Format , FormatConfig(..) , defaultFormatConfig , Event(..) , Progress , Path , Location(..) , Seconds(..) , Item(..) , Result(..) , FailureReason(..) , monadic -- * Register a formatter , registerFormatter , useFormatter , liftFormatter -- * Re-exports , SpecWith , Config , modifyConfig ) where import Test.Hspec.Core.Runner (Config(..)) import Test.Hspec.Core.Spec (modifyConfig, SpecWith) import Test.Hspec.Core.Format hiding (FormatConfig(..), defaultFormatConfig) import qualified Test.Hspec.Core.Format as Latest import Test.Hspec.Api.Format.V2.Config -- | -- Make a formatter available for use with @--format@. registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config registerFormatter = registerFormatter_ . liftFormatter -- | -- Make a formatter available for use with @--format@ and use it by default. useFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config useFormatter (liftFormatter -> formatter@(_, format)) config = (registerFormatter_ formatter config) { configFormat = Just format } -- copy of Test.Hspec.Core.Runner.registerFormatter registerFormatter_ :: (String, Latest.FormatConfig -> IO Latest.Format) -> Config -> Config registerFormatter_ formatter config = config { configAvailableFormatters = formatter : configAvailableFormatters config } -- | Make a formatter compatible with types from "Test.Hspec.Core.Format". liftFormatter :: (String, FormatConfig -> IO Format) -> (String, Latest.FormatConfig -> IO Format) liftFormatter = fmap liftFormat where liftFormat :: (FormatConfig -> IO Format) -> Latest.FormatConfig -> IO Format liftFormat format = format . unliftFormatConfig hspec-api-2.11.9/src/Test/Hspec/Api/Format/V2/0000755000000000000000000000000007346545000016646 5ustar0000000000000000hspec-api-2.11.9/src/Test/Hspec/Api/Format/V2/Config.hs0000644000000000000000000000351507346545000020413 0ustar0000000000000000module Test.Hspec.Api.Format.V2.Config where import Control.Exception (SomeException) import qualified Test.Hspec.Core.Format as Latest data FormatConfig = FormatConfig { formatConfigUseColor :: Bool , formatConfigReportProgress :: Bool , formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool , formatConfigDiffContext :: Maybe Int , formatConfigExternalDiff :: Maybe (String -> String -> IO ()) , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String)) , formatConfigFormatException :: SomeException -> String -- ^ @since 2.11.5 , formatConfigPrintTimes :: Bool , formatConfigHtmlOutput :: Bool , formatConfigPrintCpuTime :: Bool , formatConfigUsedSeed :: Integer , formatConfigExpectedTotalCount :: Int } -- ^ @since 2.11.5 defaultFormatConfig :: FormatConfig defaultFormatConfig = unliftFormatConfig Latest.defaultFormatConfig unliftFormatConfig :: Latest.FormatConfig -> FormatConfig unliftFormatConfig config = FormatConfig { formatConfigUseColor = Latest.formatConfigUseColor config , formatConfigReportProgress = Latest.formatConfigReportProgress config , formatConfigOutputUnicode = Latest.formatConfigOutputUnicode config , formatConfigUseDiff = Latest.formatConfigUseDiff config , formatConfigDiffContext = Latest.formatConfigDiffContext config , formatConfigExternalDiff = Latest.formatConfigExternalDiff config , formatConfigPrettyPrintFunction = Latest.formatConfigPrettyPrintFunction config , formatConfigFormatException = Latest.formatConfigFormatException config , formatConfigPrintTimes = Latest.formatConfigPrintTimes config , formatConfigHtmlOutput = Latest.formatConfigHtmlOutput config , formatConfigPrintCpuTime = Latest.formatConfigPrintCpuTime config , formatConfigUsedSeed = Latest.formatConfigUsedSeed config , formatConfigExpectedTotalCount = Latest.formatConfigExpectedTotalCount config } hspec-api-2.11.9/src/Test/Hspec/Api/Formatters/0000755000000000000000000000000007346545000017255 5ustar0000000000000000hspec-api-2.11.9/src/Test/Hspec/Api/Formatters/V1.hs0000644000000000000000000000424507346545000020104 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# LANGUAGE ViewPatterns #-} -- | -- Stability: deprecated -- -- This module contains formatters that can be used with `hspecWith`: -- -- @ -- import Test.Hspec -- import Test.Hspec.Api.Formatters.V1 -- -- main :: IO () -- main = hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) spec -- -- formatter :: Formatter -- formatter = ... -- -- spec :: Spec -- spec = ... -- @ module Test.Hspec.Api.Formatters.V1 ( -- * Register a formatter useFormatter , formatterToFormat -- * Formatters , silent , checks , specdoc , progress , failed_examples -- * Implementing a custom Formatter -- | -- A formatter is a set of actions. Each action is evaluated when a certain -- situation is encountered during a test run. -- -- Actions live in the `FormatM` monad. It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..) , FailureReason (..) , FormatM -- ** Accessing the runner state , getSuccessCount , getPendingCount , getFailCount , getTotalCount , FailureRecord (..) , getFailMessages , usedSeed , Seconds(..) , getCPUTime , getRealTime -- ** Appending to the generated report , write , writeLine , writeTransient -- ** Dealing with colors , withInfoColor , withSuccessColor , withPendingColor , withFailColor , useDiff , extraChunk , missingChunk -- ** Helpers , formatException -- * Re-exports , Location(..) , Progress , SpecWith , Config , modifyConfig ) where import Test.Hspec.Core.Formatters.V1 import Test.Hspec.Core.Runner (Config(..)) import Test.Hspec.Core.Format hiding (FailureReason(..)) import Test.Hspec.Core.Spec (modifyConfig, SpecWith) -- | -- Make a formatter available for use with @--format@ and use it by default. useFormatter :: (String, Formatter) -> Config -> Config useFormatter (fmap formatterToFormat -> formatter@(_, format)) config = (registerFormatter_ formatter config) { configFormat = Just format } -- copy of Test.Hspec.Core.Runner.registerFormatter registerFormatter_ :: (String, FormatConfig -> IO Format) -> Config -> Config registerFormatter_ formatter config = config { configAvailableFormatters = formatter : configAvailableFormatters config } hspec-api-2.11.9/src/Test/Hspec/Api/Formatters/V2.hs0000644000000000000000000001111607346545000020100 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} -- | -- Stability: stable -- -- This module contains formatters that can be used with `hspecWith`: -- -- @ -- import Test.Hspec -- import Test.Hspec.Api.Formatters.V1 -- -- main :: IO () -- main = hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) spec -- -- formatter :: Formatter -- formatter = ... -- -- spec :: Spec -- spec = ... -- @ module Test.Hspec.Api.Formatters.V2 ( -- * Register a formatter registerFormatter , useFormatter , formatterToFormat -- * Formatters , silent , checks , specdoc , progress , failed_examples -- * Implementing a custom Formatter -- | -- A formatter is a set of actions. Each action is evaluated when a certain -- situation is encountered during a test run. -- -- Actions live in the `FormatM` monad. It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..) , Path , Progress , Location(..) , Item(..) , Result(..) , FailureReason (..) , FormatM -- ** Accessing the runner state , getSuccessCount , getPendingCount , getFailCount , getTotalCount , getExpectedTotalCount , FailureRecord (..) , getFailMessages , usedSeed , printTimes , Seconds(..) , getCPUTime , getRealTime -- ** Appending to the generated report , write , writeLine , writeTransient -- ** Dealing with colors , withInfoColor , withSuccessColor , withPendingColor , withFailColor , outputUnicode , useDiff , diffContext , externalDiffAction , prettyPrint , prettyPrintFunction , extraChunk , missingChunk -- ** Helpers , formatLocation , formatException -- * Re-exports , SpecWith , Config , modifyConfig ) where import Test.Hspec.Core.Format (FormatConfig, Format) import Test.Hspec.Core.Formatters.V1 (FailureRecord(..)) import Test.Hspec.Api.Format.V1.Internal import qualified Test.Hspec.Api.Formatters.V3 as V3 import Test.Hspec.Api.Formatters.V3 hiding ( registerFormatter , useFormatter , formatterToFormat , FormatConfig , silent , checks , specdoc , progress , failed_examples , Formatter(..) , Item(..) , Result(..) , FailureReason(..) , FailureRecord(..) , getFailMessages ) -- | -- Make a formatter available for use with @--format@. registerFormatter :: (String, Formatter) -> Config -> Config registerFormatter formatter = V3.registerFormatter (fmap liftFormatter formatter) -- | -- Make a formatter available for use with @--format@ and use it by default. useFormatter :: (String, Formatter) -> Config -> Config useFormatter formatter = V3.useFormatter (liftFormatter <$> formatter) formatterToFormat :: Formatter -> FormatConfig -> IO Format formatterToFormat = V3.formatterToFormat . liftFormatter silent :: Formatter silent = unliftFormatter V3.silent checks :: Formatter checks = unliftFormatter V3.checks specdoc :: Formatter specdoc = unliftFormatter V3.specdoc progress :: Formatter progress = unliftFormatter V3.progress failed_examples :: Formatter failed_examples = unliftFormatter V3.failed_examples data Formatter = Formatter { -- | evaluated before a test run formatterStarted :: FormatM () -- | evaluated before each spec group , formatterGroupStarted :: Path -> FormatM () -- | evaluated after each spec group , formatterGroupDone :: Path -> FormatM () -- | used to notify the progress of the currently evaluated example , formatterProgress :: Path -> Progress -> FormatM () -- | evaluated before each spec item , formatterItemStarted :: Path -> FormatM () -- | evaluated after each spec item , formatterItemDone :: Path -> Item -> FormatM () -- | evaluated after a test run , formatterDone :: FormatM () } -- | Get the list of accumulated failure messages. getFailMessages :: FormatM [FailureRecord] getFailMessages = map unliftFailureRecord <$> V3.getFailMessages liftFormatter :: Formatter -> V3.Formatter liftFormatter Formatter{..} = V3.Formatter{ formatterStarted , formatterGroupStarted , formatterGroupDone , formatterProgress , formatterItemStarted , formatterItemDone = \ path -> formatterItemDone path . unliftItem , formatterDone } unliftFormatter :: V3.Formatter -> Formatter unliftFormatter V3.Formatter{..} = Formatter{ formatterStarted , formatterGroupStarted , formatterGroupDone , formatterProgress , formatterItemStarted , formatterItemDone = \ path -> formatterItemDone path . liftItem , formatterDone } unliftFailureRecord :: V3.FailureRecord -> FailureRecord unliftFailureRecord V3.FailureRecord{..} = FailureRecord { failureRecordLocation , failureRecordPath , failureRecordMessage = unliftFailureReason failureRecordMessage } hspec-api-2.11.9/src/Test/Hspec/Api/Formatters/V3.hs0000644000000000000000000000602707346545000020106 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} -- | -- Stability: stable -- -- This module contains formatters that can be used with `hspecWith`: -- -- @ -- import Test.Hspec -- import Test.Hspec.Api.Formatters.V1 -- -- main :: IO () -- main = hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) spec -- -- formatter :: Formatter -- formatter = ... -- -- spec :: Spec -- spec = ... -- @ module Test.Hspec.Api.Formatters.V3 ( -- * Register a formatter registerFormatter , useFormatter , formatterToFormat -- * Formatters , silent , checks , specdoc , progress , failed_examples -- * Implementing a custom Formatter -- | -- A formatter is a set of actions. Each action is evaluated when a certain -- situation is encountered during a test run. -- -- Actions live in the `FormatM` monad. It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..) , Path , Progress , Location(..) , Item(..) , Result(..) , FailureReason (..) , FormatM -- ** Accessing config values , getConfig , getConfigValue , FormatConfig(..) , defaultFormatConfig -- ** Accessing the runner state , getSuccessCount , getPendingCount , getFailCount , getTotalCount , getExpectedTotalCount , FailureRecord (..) , getFailMessages , usedSeed , printTimes , Seconds(..) , getCPUTime , getRealTime -- ** Appending to the generated report , write , writeLine , writeTransient -- ** Dealing with colors , withInfoColor , withSuccessColor , withPendingColor , withFailColor , outputUnicode , useDiff , diffContext , externalDiffAction , prettyPrint , prettyPrintFunction , extraChunk , missingChunk -- ** expert mode , unlessExpert -- ** Helpers , formatLocation , formatException -- * Re-exports , SpecWith , Config , modifyConfig ) where import Test.Hspec.Core.Formatters.V2 hiding (FormatConfig(..), getConfig, getConfigValue) import qualified Test.Hspec.Core.Formatters.V2 as Core import Test.Hspec.Core.Runner (Config(..)) import Test.Hspec.Core.Format (Format) import Test.Hspec.Core.Spec (modifyConfig, SpecWith) import Test.Hspec.Api.Format.V2.Config -- | @since 2.11.5 getConfig :: FormatM FormatConfig getConfig = unliftFormatConfig <$> Core.getConfig -- | @since 2.11.5 getConfigValue :: (FormatConfig -> a) -> FormatM a getConfigValue f = f <$> getConfig -- | -- Make a formatter available for use with @--format@. registerFormatter :: (String, Formatter) -> Config -> Config registerFormatter formatter = registerFormatter_ (fmap formatterToFormat formatter) -- | -- Make a formatter available for use with @--format@ and use it by default. useFormatter :: (String, Formatter) -> Config -> Config useFormatter (fmap formatterToFormat -> formatter@(_, format)) config = (registerFormatter_ formatter config) { configFormat = Just format } -- copy of Test.Hspec.Core.Runner.registerFormatter registerFormatter_ :: (String, Core.FormatConfig -> IO Format) -> Config -> Config registerFormatter_ formatter config = config { configAvailableFormatters = formatter : configAvailableFormatters config } hspec-api-2.11.9/test/0000755000000000000000000000000007346545000012625 5ustar0000000000000000hspec-api-2.11.9/test/Spec.hs0000644000000000000000000000005407346545000014052 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-api-2.11.9/test/Test/Hspec/Api/Format/0000755000000000000000000000000007346545000016547 5ustar0000000000000000hspec-api-2.11.9/test/Test/Hspec/Api/Format/V1Spec.hs0000644000000000000000000000116007346545000020202 0ustar0000000000000000module Test.Hspec.Api.Format.V1Spec (spec) where import Test.Hspec import Test.Hspec.Runner import Data.IORef import Test.Hspec.Api.Format.V1 spec :: Spec spec = do describe "useFormatter" $ do it "sets a formatter to be used with a given config" $ do ref <- newIORef "NAY!" let formatter :: Format formatter event = case event of ItemDone {} -> writeIORef ref "YAY!" _ -> return () hspecWith (useFormatter ("my-formatter", \ _ -> return formatter) defaultConfig) $ it "" True readIORef ref `shouldReturn` "YAY!" hspec-api-2.11.9/test/Test/Hspec/Api/Format/V2Spec.hs0000644000000000000000000000116007346545000020203 0ustar0000000000000000module Test.Hspec.Api.Format.V2Spec (spec) where import Test.Hspec import Test.Hspec.Runner import Data.IORef import Test.Hspec.Api.Format.V2 spec :: Spec spec = do describe "useFormatter" $ do it "sets a formatter to be used with a given config" $ do ref <- newIORef "NAY!" let formatter :: Format formatter event = case event of ItemDone {} -> writeIORef ref "YAY!" _ -> return () hspecWith (useFormatter ("my-formatter", \ _ -> return formatter) defaultConfig) $ it "" True readIORef ref `shouldReturn` "YAY!" hspec-api-2.11.9/test/Test/Hspec/Api/Formatters/0000755000000000000000000000000007346545000017445 5ustar0000000000000000hspec-api-2.11.9/test/Test/Hspec/Api/Formatters/V1Spec.hs0000644000000000000000000000117207346545000021103 0ustar0000000000000000module Test.Hspec.Api.Formatters.V1Spec (spec) where import Test.Hspec import Test.Hspec.Runner import Data.IORef import Control.Monad.IO.Class import Test.Hspec.Api.Formatters.V1 spec :: Spec spec = do describe "useFormatter" $ do it "sets a formatter to be used with a given config" $ do ref <- newIORef "NAY!" let formatter :: Formatter formatter = silent { exampleStarted = \ _ -> liftIO $ writeIORef ref "YAY!" } hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) $ it "" True readIORef ref `shouldReturn` "YAY!" hspec-api-2.11.9/test/Test/Hspec/Api/Formatters/V2Spec.hs0000644000000000000000000000120007346545000021074 0ustar0000000000000000module Test.Hspec.Api.Formatters.V2Spec (spec) where import Test.Hspec import Test.Hspec.Runner import Data.IORef import Control.Monad.IO.Class import Test.Hspec.Api.Formatters.V2 spec :: Spec spec = do describe "useFormatter" $ do it "sets a formatter to be used with a given config" $ do ref <- newIORef "NAY!" let formatter :: Formatter formatter = silent { formatterItemStarted = \ _ -> liftIO $ writeIORef ref "YAY!" } hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) $ it "" True readIORef ref `shouldReturn` "YAY!" hspec-api-2.11.9/test/Test/Hspec/Api/Formatters/V3Spec.hs0000644000000000000000000000120007346545000021075 0ustar0000000000000000module Test.Hspec.Api.Formatters.V3Spec (spec) where import Test.Hspec import Test.Hspec.Runner import Data.IORef import Control.Monad.IO.Class import Test.Hspec.Api.Formatters.V3 spec :: Spec spec = do describe "useFormatter" $ do it "sets a formatter to be used with a given config" $ do ref <- newIORef "NAY!" let formatter :: Formatter formatter = silent { formatterItemStarted = \ _ -> liftIO $ writeIORef ref "YAY!" } hspecWith (useFormatter ("my-formatter", formatter) defaultConfig) $ it "" True readIORef ref `shouldReturn` "YAY!" hspec-api-2.11.9/version.yaml0000644000000000000000000000034207346545000014216 0ustar0000000000000000version: &version 2.11.9 synopsis: A Testing Framework for Haskell author: Simon Hengel maintainer: Simon Hengel category: Testing stability: experimental homepage: https://hspec.github.io/