packages feed

hspec-core 2.8.5 → 2.9.0

raw patch · 20 files changed

+616/−590 lines, 20 files

Files

help.txt view
@@ -30,6 +30,7 @@                                         of checks, specdoc, progress,                                         failed-examples or silent                 --[no-]color            colorize the output+                --[no-]unicode          output unicode                 --[no-]diff             show colorized diffs                 --[no-]times            report times for individual spec items                 --print-cpu-time        include used CPU time in summary
hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.8.5+version:          2.9.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2021 Simon Hengel,@@ -76,9 +76,9 @@       Test.Hspec.Core.Example.Location       Test.Hspec.Core.FailureReport       Test.Hspec.Core.Formatters.Diff-      Test.Hspec.Core.Formatters.Free       Test.Hspec.Core.Formatters.Internal-      Test.Hspec.Core.Formatters.Monad+      Test.Hspec.Core.Formatters.V1.Free+      Test.Hspec.Core.Formatters.V1.Monad       Test.Hspec.Core.QuickCheckUtil       Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Runner.PrintSlowSpecItems@@ -142,10 +142,10 @@       Test.Hspec.Core.Format       Test.Hspec.Core.Formatters       Test.Hspec.Core.Formatters.Diff-      Test.Hspec.Core.Formatters.Free       Test.Hspec.Core.Formatters.Internal-      Test.Hspec.Core.Formatters.Monad       Test.Hspec.Core.Formatters.V1+      Test.Hspec.Core.Formatters.V1.Free+      Test.Hspec.Core.Formatters.V1.Monad       Test.Hspec.Core.Formatters.V2       Test.Hspec.Core.Hooks       Test.Hspec.Core.QuickCheck
src/Test/Hspec/Core/Config.hs view
@@ -2,6 +2,7 @@ module Test.Hspec.Core.Config (   Config (..) , ColorMode(..)+, UnicodeMode(..) , defaultConfig , readConfig , configAddFilter@@ -29,7 +30,7 @@  import           Test.Hspec.Core.Util import           Test.Hspec.Core.Config.Options-import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), defaultConfig, filterOr)+import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), defaultConfig, filterOr) import           Test.Hspec.Core.FailureReport import           Test.Hspec.Core.QuickCheckUtil (mkGen) import           Test.Hspec.Core.Example (Params(..), defaultParams)
src/Test/Hspec/Core/Config/Definition.hs view
@@ -2,6 +2,7 @@ module Test.Hspec.Core.Config.Definition (   Config(..) , ColorMode(..)+, UnicodeMode(..) , filterOr , defaultConfig @@ -31,6 +32,9 @@ data ColorMode = ColorAuto | ColorNever | ColorAlways   deriving (Eq, Show) +data UnicodeMode = UnicodeAuto | UnicodeNever | UnicodeAlways+  deriving (Eq, Show)+ data Config = Config {   configIgnoreConfigFile :: Bool , configDryRun :: Bool@@ -38,7 +42,7 @@ , configFailOnFocused :: Bool , configPrintSlowItems :: Maybe Int , configPrintCpuTime :: Bool-, configFastFail :: Bool+, configFailFast :: Bool , configRandomize :: Bool , configFailureReport :: Maybe FilePath , configRerun :: Bool@@ -56,8 +60,10 @@ , configQuickCheckMaxShrinks :: Maybe Int , configSmallCheckDepth :: Int , configColorMode :: ColorMode+, configUnicodeMode :: UnicodeMode , configDiff :: Bool , configTimes :: Bool+, configAvailableFormatters :: [(String, FormatConfig -> IO Format)] , configFormat :: Maybe (FormatConfig -> IO Format) , configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead , configHtmlOutput :: Bool@@ -72,7 +78,7 @@ , configFailOnFocused = False , configPrintSlowItems = Nothing , configPrintCpuTime = False-, configFastFail = False+, configFailFast = False , configRandomize = False , configFailureReport = Nothing , configRerun = False@@ -86,8 +92,16 @@ , configQuickCheckMaxShrinks = Nothing , configSmallCheckDepth = paramsSmallCheckDepth defaultParams , configColorMode = ColorAuto+, configUnicodeMode = UnicodeAuto , configDiff = True , configTimes = False+, configAvailableFormatters = map (fmap V2.formatterToFormat) [+    ("checks", V2.checks)+  , ("specdoc", V2.specdoc)+  , ("progress", V2.progress)+  , ("failed-examples", V2.failed_examples)+  , ("silent", V2.silent)+  ] , configFormat = Nothing , configFormatter = Nothing , configHtmlOutput = False@@ -112,10 +126,11 @@ argument :: String -> (String -> Maybe a) -> (a -> Config -> Config) -> OptionSetter Config argument name parser setter = Arg name $ \ input c -> flip setter c <$> parser input -formatterOptions :: [Option Config]-formatterOptions = [+formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config]+formatterOptions formatters = [     mkOption "format" (Just 'f') (argument "FORMATTER" readFormatter setFormatter) helpForFormat   , mkFlag "color" setColor "colorize the output"+  , mkFlag "unicode" setUnicode "output unicode"   , mkFlag "diff" setDiff "show colorized diffs"   , mkFlag "times" setTimes "report times for individual spec items"   , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"@@ -128,15 +143,6 @@   where     setHtml config = config {configHtmlOutput = True} -    formatters :: [(String, FormatConfig -> IO Format)]-    formatters = map (fmap V2.formatterToFormat) [-        ("checks", V2.checks)-      , ("specdoc", V2.specdoc)-      , ("progress", V2.progress)-      , ("failed-examples", V2.failed_examples)-      , ("silent", V2.silent)-      ]-     helpForFormat :: String     helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters) @@ -149,6 +155,9 @@     setColor :: Bool -> Config -> Config     setColor v config = config {configColorMode = if v then ColorAlways else ColorNever} +    setUnicode :: Bool -> Config -> Config+    setUnicode v config = config {configUnicodeMode = if v then UnicodeAlways else UnicodeNever}+     setDiff :: Bool -> Config -> Config     setDiff v config = config {configDiff = v} @@ -214,7 +223,7 @@     mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything"   , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items"   , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items"-  , mkFlag "fail-fast" setFastFail "abort on first failure"+  , mkFlag "fail-fast" setFailFast "abort on first failure"   , mkFlag "randomize" setRandomize "randomize execution order"   , mkOptionNoArg "rerun" (Just 'r') setRerun "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"   , option "failure-report" (argument "FILE" return setFailureReport) "read/write a failure report for use with --rerun"@@ -243,8 +252,8 @@     setFailOnFocused :: Bool -> Config -> Config     setFailOnFocused value config = config {configFailOnFocused = value} -    setFastFail :: Bool -> Config -> Config-    setFastFail value config = config {configFastFail = value}+    setFailFast :: Bool -> Config -> Config+    setFailFast value config = config {configFailFast = value}      setRandomize :: Bool -> Config -> Config     setRandomize value config = config {configRandomize = value}
src/Test/Hspec/Core/Config/Options.hs view
@@ -11,6 +11,7 @@  import           System.Exit +import           Test.Hspec.Core.Format (Format, FormatConfig) import           Test.Hspec.Core.Config.Definition import qualified GetOpt.Declarative as Declarative import           GetOpt.Declarative.Interpret (parse, interpretOptions, ParseResult(..))@@ -21,15 +22,15 @@ envVarName :: String envVarName = "HSPEC_OPTIONS" -commandLineOptions :: [(String, [Declarative.Option Config])]-commandLineOptions =+commandLineOptions :: [(String, FormatConfig -> IO Format)] -> [(String, [Declarative.Option Config])]+commandLineOptions formatters =     ("OPTIONS", commandLineOnlyOptions)-  : otherOptions+  : otherOptions formatters -otherOptions :: [(String, [Declarative.Option Config])]-otherOptions = [+otherOptions :: [(String, FormatConfig -> IO Format)] -> [(String, [Declarative.Option Config])]+otherOptions formatters = [     ("RUNNER OPTIONS", runnerOptions)-  , ("FORMATTER OPTIONS", formatterOptions)+  , ("FORMATTER OPTIONS", formatterOptions formatters)   , ("OPTIONS FOR QUICKCHECK", quickCheckOptions)   , ("OPTIONS FOR SMALLCHECK", smallCheckOptions)   ]@@ -58,15 +59,18 @@ #endif  parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config-parseCommandLineOptions prog args config = case Declarative.parseCommandLineOptions commandLineOptions prog args config of+parseCommandLineOptions prog args config = case Declarative.parseCommandLineOptions (commandLineOptions formatters) prog args config of   Success c -> Right c   Help message -> Left (ExitSuccess, message)   Failure message -> Left (ExitFailure 1, message)+  where+    formatters = configAvailableFormatters config  parseEnvironmentOptions :: [(String, String)] -> Config -> Either (ExitCode, String) ([String], Config)-parseEnvironmentOptions env config = case Declarative.parseEnvironmentOptions "HSPEC" env config (concatMap snd commandLineOptions) of+parseEnvironmentOptions env config = case Declarative.parseEnvironmentOptions "HSPEC" env config (concatMap snd $ commandLineOptions formatters) of   (warnings, c) -> Right (map formatWarning warnings, c)   where+    formatters = configAvailableFormatters config     formatWarning (Declarative.InvalidValue name value) = "invalid value `" ++ value ++ "' for environment variable " ++ name  parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config@@ -83,7 +87,9 @@   Left err -> failure err   where     options :: [Declarative.Option Config]-    options = filter Declarative.optionDocumented $ concatMap snd otherOptions+    options = filter Declarative.optionDocumented $ concatMap snd (otherOptions formatters)++    formatters = configAvailableFormatters config      failure err = Left (ExitFailure 1, prog ++ ": " ++ message)       where
src/Test/Hspec/Core/Format.hs view
@@ -57,12 +57,13 @@  data FormatConfig = FormatConfig {   formatConfigUseColor :: Bool+, formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool , formatConfigPrintTimes :: Bool , formatConfigHtmlOutput :: Bool , formatConfigPrintCpuTime :: Bool , formatConfigUsedSeed :: Integer-, formatConfigItemCount :: Int+, formatConfigExpectedTotalCount :: Int } deriving (Eq, Show)  data Signal = Ok | NotOk SomeException
− src/Test/Hspec/Core/Formatters/Free.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-module Test.Hspec.Core.Formatters.Free where--import           Prelude ()-import           Test.Hspec.Core.Compat--data Free f a = Free (f (Free f a)) | Pure a-  deriving Functor--instance Functor f => Applicative (Free f) where-  pure = Pure-  Pure f <*> Pure a = Pure (f a)-  Pure f <*> Free m = Free (fmap f <$> m)-  Free m <*> b = Free (fmap (<*> b) m)--instance Functor f => Monad (Free f) where-  return = pure-  Pure a >>= f = f a-  Free m >>= f = Free (fmap (>>= f) m)--liftF :: Functor f => f a -> Free f a-liftF command = Free (fmap Pure command)
src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -2,13 +2,42 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} module Test.Hspec.Core.Formatters.Internal (-  FormatM-, runFormatM-, interpret-, increaseSuccessCount-, increasePendingCount-, addFailMessage+  Formatter(..)+, Item(..)+, Result(..)+, FailureReason(..)+, FormatM , formatterToFormat++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount+, getExpectedTotalCount++, FailureRecord(..)+, getFailMessages+, usedSeed++, printTimes+, getCPUTime+, getRealTime++, write+, writeLine+, writeTransient++, withInfoColor+, withSuccessColor+, withPendingColor+, withFailColor++, outputUnicode++, useDiff+, extraChunk+, missingChunk+ #ifdef TEST , overwriteWith #endif@@ -26,49 +55,74 @@ import           Data.Char (isSpace) import qualified System.CPUTime as CPUTime -import qualified Test.Hspec.Core.Formatters.Monad as M-import           Test.Hspec.Core.Formatters.Monad (Environment(..), interpretWith, FailureRecord(..))+import           Test.Hspec.Core.Formatters.V1.Monad (FailureRecord(..)) import           Test.Hspec.Core.Format import           Test.Hspec.Core.Clock -formatterToFormat :: M.Formatter -> FormatConfig -> IO Format-formatterToFormat M.Formatter{..} config = monadic (runFormatM config) $ \ event -> case event of-  Started -> interpret formatterStarted-  GroupStarted path -> interpret $ formatterGroupStarted path-  GroupDone path -> interpret $ formatterGroupDone path-  Progress path progress -> interpret $ formatterProgress path progress-  ItemStarted path -> interpret $ formatterItemStarted path+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 ()+}++formatterToFormat :: Formatter -> FormatConfig -> IO Format+formatterToFormat Formatter{..} config = monadic (runFormatM config) $ \ event -> case event of+  Started -> formatterStarted+  GroupStarted path -> formatterGroupStarted path+  GroupDone path -> formatterGroupDone path+  Progress path progress -> formatterProgress path progress+  ItemStarted path -> formatterItemStarted path   ItemDone path item -> do     clearTransientOutput     case itemResult item of       Success {} -> increaseSuccessCount       Pending {} -> increasePendingCount       Failure loc err -> addFailMessage (loc <|> itemLocation item) path err-    interpret $ formatterItemDone path item-  Done _ -> interpret formatterDone+    formatterItemDone path item+  Done _ -> formatterDone -interpret :: M.FormatM a -> FormatM a-interpret = interpretWith Environment {-  environmentGetSuccessCount = getSuccessCount-, environmentGetPendingCount = getPendingCount-, environmentGetFailMessages = getFailMessages-, environmentGetFinalCount = getItemCount-, environmentUsedSeed = usedSeed-, environmentPrintTimes = gets (formatConfigPrintTimes . stateConfig)-, environmentGetCPUTime = getCPUTime-, environmentGetRealTime = getRealTime-, environmentWrite = write-, environmentWriteTransient = writeTransient-, environmentWithFailColor = withFailColor-, environmentWithSuccessColor = withSuccessColor-, environmentWithPendingColor = withPendingColor-, environmentWithInfoColor = withInfoColor-, environmentUseDiff = gets (formatConfigUseDiff . stateConfig)-, environmentExtraChunk = extraChunk-, environmentMissingChunk = missingChunk-, environmentLiftIO = liftIO-}+-- | Get the number of failed examples encountered so far.+getFailCount :: FormatM Int+getFailCount = length <$> getFailMessages +-- | Return `True` if the user requested colorized diffs, `False` otherwise.+useDiff :: FormatM Bool+useDiff = getConfig formatConfigUseDiff++-- | Return `True` if the user requested unicode output, `False` otherwise.+outputUnicode :: FormatM Bool+outputUnicode = getConfig formatConfigOutputUnicode++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = write s >> write "\n"++-- | Return `True` if the user requested time reporting for individual spec+-- items, `False` otherwise.+printTimes :: FormatM Bool+printTimes = gets (formatConfigPrintTimes . stateConfig)++-- | Get the total number of examples encountered so far.+getTotalCount :: FormatM Int+getTotalCount = sum <$> sequence [getSuccessCount, getFailCount, getPendingCount]+ -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a gets f = FormatM $ do@@ -137,8 +191,8 @@  -- | Get the number of spec items that will have been encountered when this run -- completes (if it is not terminated early).-getItemCount :: FormatM Int-getItemCount = getConfig formatConfigItemCount+getExpectedTotalCount :: FormatM Int+getExpectedTotalCount = getConfig formatConfigExpectedTotalCount  overwriteWith :: String -> String -> String overwriteWith old new@@ -219,8 +273,8 @@ -- | Output given chunk in red. extraChunk :: String -> FormatM () extraChunk s = do-  useDiff <- getConfig formatConfigUseDiff-  case useDiff of+  diff <- getConfig formatConfigUseDiff+  case diff of     True -> extra s     False -> write s   where@@ -230,8 +284,8 @@ -- | Output given chunk in green. missingChunk :: String -> FormatM () missingChunk s = do-  useDiff <- getConfig formatConfigUseDiff-  case useDiff of+  diff <- getConfig formatConfigUseDiff+  case diff of     True -> missing s     False -> write s   where
− src/Test/Hspec/Core/Formatters/Monad.hs 
@@ -1,260 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ExistentialQuantification #-}-module Test.Hspec.Core.Formatters.Monad (-  Formatter (..)-, Item(..)-, Result(..)-, FailureReason (..)-, FormatM--, getSuccessCount-, getPendingCount-, getFailCount-, getTotalCount-, getFinalCount--, FailureRecord (..)-, getFailMessages-, usedSeed--, printTimes-, getCPUTime-, getRealTime--, write-, writeLine-, writeTransient--, withInfoColor-, withSuccessColor-, withPendingColor-, withFailColor--, useDiff-, extraChunk-, missingChunk--, Environment(..)-, interpretWith-) where--import           Prelude ()-import           Test.Hspec.Core.Compat--import           Control.Monad.IO.Class--import           Test.Hspec.Core.Formatters.Free-import           Test.Hspec.Core.Clock-import           Test.Hspec.Core.Format--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 ()-}--data FailureRecord = FailureRecord {-  failureRecordLocation :: Maybe Location-, failureRecordPath     :: Path-, failureRecordMessage  :: FailureReason-}--data FormatF next =-    GetSuccessCount (Int -> next)-  | GetPendingCount (Int -> next)-  | GetFailMessages ([FailureRecord] -> next)-  | GetFinalCount (Int -> next)-  | UsedSeed (Integer -> next)-  | PrintTimes (Bool -> next)-  | GetCPUTime (Maybe Seconds -> next)-  | GetRealTime (Seconds -> next)-  | Write String next-  | WriteTransient String next-  | forall a. WithFailColor (FormatM a) (a -> next)-  | forall a. WithSuccessColor (FormatM a) (a -> next)-  | forall a. WithPendingColor (FormatM a) (a -> next)-  | forall a. WithInfoColor (FormatM a) (a -> next)-  | UseDiff (Bool -> next)-  | ExtraChunk String next-  | MissingChunk String next-  | forall a. LiftIO (IO a) (a -> next)--instance Functor FormatF where -- deriving this instance would require GHC >= 7.10.1-  fmap f x = case x of-    GetSuccessCount next -> GetSuccessCount (fmap f next)-    GetPendingCount next -> GetPendingCount (fmap f next)-    GetFailMessages next -> GetFailMessages (fmap f next)-    GetFinalCount next -> GetFinalCount (fmap f next)-    UsedSeed next -> UsedSeed (fmap f next)-    PrintTimes next -> PrintTimes (fmap f next)-    GetCPUTime next -> GetCPUTime (fmap f next)-    GetRealTime next -> GetRealTime (fmap f next)-    Write s next -> Write s (f next)-    WriteTransient s next -> WriteTransient s (f next)-    WithFailColor action next -> WithFailColor action (fmap f next)-    WithSuccessColor action next -> WithSuccessColor action (fmap f next)-    WithPendingColor action next -> WithPendingColor action (fmap f next)-    WithInfoColor action next -> WithInfoColor action (fmap f next)-    UseDiff next -> UseDiff (fmap f next)-    ExtraChunk s next -> ExtraChunk s (f next)-    MissingChunk s next -> MissingChunk s (f next)-    LiftIO action next -> LiftIO action (fmap f next)--type FormatM = Free FormatF--instance MonadIO FormatM where-  liftIO s = liftF (LiftIO s id)--data Environment m = Environment {-  environmentGetSuccessCount :: m Int-, environmentGetPendingCount :: m Int-, environmentGetFailMessages :: m [FailureRecord]-, environmentGetFinalCount :: m Int-, environmentUsedSeed :: m Integer-, environmentPrintTimes :: m Bool-, environmentGetCPUTime :: m (Maybe Seconds)-, environmentGetRealTime :: m Seconds-, environmentWrite :: String -> m ()-, environmentWriteTransient :: String -> m ()-, environmentWithFailColor :: forall a. m a -> m a-, environmentWithSuccessColor :: forall a. m a -> m a-, environmentWithPendingColor :: forall a. m a -> m a-, environmentWithInfoColor :: forall a. m a -> m a-, environmentUseDiff :: m Bool-, environmentExtraChunk :: String -> m ()-, environmentMissingChunk :: String -> m ()-, environmentLiftIO :: forall a. IO a -> m a-}--interpretWith :: forall m a. Monad m => Environment m -> FormatM a -> m a-interpretWith Environment{..} = go-  where-    go :: forall b. FormatM b -> m b-    go m = case m of-      Pure value -> return value-      Free action -> case action of-        GetSuccessCount next -> environmentGetSuccessCount >>= go . next-        GetPendingCount next -> environmentGetPendingCount >>= go . next-        GetFailMessages next -> environmentGetFailMessages >>= go . next-        GetFinalCount next -> environmentGetFinalCount >>= go . next-        UsedSeed next -> environmentUsedSeed >>= go . next-        PrintTimes next -> environmentPrintTimes >>= go . next-        GetCPUTime next -> environmentGetCPUTime >>= go . next-        GetRealTime next -> environmentGetRealTime >>= go . next-        Write s next -> environmentWrite s >> go next-        WriteTransient s next -> environmentWriteTransient s >> go next-        WithFailColor inner next -> environmentWithFailColor (go inner) >>= go . next-        WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next-        WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next-        WithInfoColor inner next -> environmentWithInfoColor (go inner) >>= go . next-        UseDiff next -> environmentUseDiff >>= go . next-        ExtraChunk s next -> environmentExtraChunk s >> go next-        MissingChunk s next -> environmentMissingChunk s >> go next-        LiftIO inner next -> environmentLiftIO inner >>= go . next---- | Get the number of successful examples encountered so far.-getSuccessCount :: FormatM Int-getSuccessCount = liftF (GetSuccessCount id)---- | Get the number of pending examples encountered so far.-getPendingCount :: FormatM Int-getPendingCount = liftF (GetPendingCount id)---- | Get the number of failed examples encountered so far.-getFailCount :: FormatM Int-getFailCount = length <$> getFailMessages---- | Get the total number of examples encountered so far.-getTotalCount :: FormatM Int-getTotalCount = sum <$> sequence [getSuccessCount, getFailCount, getPendingCount]---- | Get the number of spec items that will have been encountered when this run--- completes (if it is not terminated early).-getFinalCount :: FormatM Int-getFinalCount = liftF (GetFinalCount id)---- | Get the list of accumulated failure messages.-getFailMessages :: FormatM [FailureRecord]-getFailMessages = liftF (GetFailMessages id)---- | The random seed that is used for QuickCheck.-usedSeed :: FormatM Integer-usedSeed = liftF (UsedSeed id)---- | Return `True` if the user requested time reporting for individual spec--- items, `False` otherwise.-printTimes :: FormatM Bool-printTimes = liftF (PrintTimes id)---- | Get the used CPU time since the test run has been started.-getCPUTime :: FormatM (Maybe Seconds)-getCPUTime = liftF (GetCPUTime id)---- | Get the passed real time since the test run has been started.-getRealTime :: FormatM Seconds-getRealTime = liftF (GetRealTime id)---- | Append some output to the report.-write :: String -> FormatM ()-write s = liftF (Write s ())---- | The same as `write`, but adds a newline character.-writeLine :: String -> FormatM ()-writeLine s = write s >> write "\n"--writeTransient :: String -> FormatM ()-writeTransient s = liftF (WriteTransient s ())---- | Set output color to red, run given action, and finally restore the default--- color.-withFailColor :: FormatM a -> FormatM a-withFailColor s = liftF (WithFailColor s id)---- | Set output color to green, run given action, and finally restore the--- default color.-withSuccessColor :: FormatM a -> FormatM a-withSuccessColor s = liftF (WithSuccessColor s id)---- | Set output color to yellow, run given action, and finally restore the--- default color.-withPendingColor :: FormatM a -> FormatM a-withPendingColor s = liftF (WithPendingColor s id)---- | Set output color to cyan, run given action, and finally restore the--- default color.-withInfoColor :: FormatM a -> FormatM a-withInfoColor s = liftF (WithInfoColor s id)---- | Return `True` if the user requested colorized diffs, `False` otherwise.-useDiff :: FormatM Bool-useDiff = liftF (UseDiff id)---- | Output given chunk in red.-extraChunk :: String -> FormatM ()-extraChunk s = liftF (ExtraChunk s ())---- | Output given chunk in green.-missingChunk :: String -> FormatM ()-missingChunk s = liftF (MissingChunk s ())
src/Test/Hspec/Core/Formatters/V1.hs view
@@ -75,8 +75,9 @@ -- -- Everything imported here has to be re-exported, so that users can implement -- their own formatters.-import Test.Hspec.Core.Formatters.Monad (-    FailureReason (..)+import Test.Hspec.Core.Formatters.V1.Monad (+    Formatter(..)+  , FailureReason(..)   , FormatM    , getSuccessCount@@ -84,7 +85,7 @@   , getFailCount   , getTotalCount -  , FailureRecord (..)+  , FailureRecord(..)   , getFailMessages   , usedSeed @@ -105,57 +106,49 @@   , missingChunk   ) -import           Test.Hspec.Core.Spec (Progress)-import           Test.Hspec.Core.Format (FormatConfig, Format, Item(..), Result(..))-import qualified Test.Hspec.Core.Formatters.V2 as V2+import           Test.Hspec.Core.Format (FormatConfig, Format)  import           Test.Hspec.Core.Formatters.Diff+import qualified Test.Hspec.Core.Formatters.V2 as V2+import           Test.Hspec.Core.Formatters.V1.Monad (Item(..), Result(..), Environment(..), interpretWith)  formatterToFormat :: Formatter -> FormatConfig -> IO Format-formatterToFormat Formatter{..} = V2.formatterToFormat V2.Formatter {-  V2.formatterStarted = headerFormatter-, V2.formatterGroupStarted = uncurry exampleGroupStarted-, V2.formatterGroupDone = \ _ -> exampleGroupDone-, V2.formatterProgress = exampleProgress-, V2.formatterItemStarted = exampleStarted-, V2.formatterItemDone = \ path item -> do+formatterToFormat = V2.formatterToFormat . legacyFormatterToFormatter++legacyFormatterToFormatter :: Formatter -> V2.Formatter+legacyFormatterToFormatter Formatter{..} = V2.Formatter {+  V2.formatterStarted = interpret headerFormatter+, V2.formatterGroupStarted = interpret . uncurry exampleGroupStarted+, V2.formatterGroupDone = interpret . const exampleGroupDone+, V2.formatterProgress = \ path -> interpret . exampleProgress path+, V2.formatterItemStarted = interpret . exampleStarted+, V2.formatterItemDone = \ path item -> interpret $ do     case itemResult item of       Success -> exampleSucceeded path (itemInfo item)       Pending _ reason -> examplePending path (itemInfo item) reason       Failure _ reason -> exampleFailed path (itemInfo item) reason-, V2.formatterDone = failedFormatter >> footerFormatter+, V2.formatterDone = interpret $ failedFormatter >> footerFormatter } -data Formatter = Formatter {--  headerFormatter :: FormatM ()---- | evaluated before each test group-, exampleGroupStarted :: [String] -> String -> FormatM ()---- | evaluated after each test group-, exampleGroupDone :: FormatM ()---- | evaluated before each example-, exampleStarted :: Path -> FormatM ()---- | used to notify the progress of the currently evaluated example-, exampleProgress :: Path -> Progress -> FormatM ()---- | evaluated after each successful example-, exampleSucceeded :: Path -> String -> FormatM ()---- | evaluated after each failed example-, exampleFailed :: Path -> String -> FailureReason -> FormatM ()---- | evaluated after each pending example-, examplePending :: Path -> String -> Maybe String -> FormatM ()---- | evaluated after a test run-, failedFormatter :: FormatM ()---- | evaluated after `failedFormatter`-, footerFormatter :: FormatM ()+interpret :: FormatM a -> V2.FormatM a+interpret = interpretWith Environment {+  environmentGetSuccessCount = V2.getSuccessCount+, environmentGetPendingCount = V2.getPendingCount+, environmentGetFailMessages = V2.getFailMessages+, environmentUsedSeed = V2.usedSeed+, environmentPrintTimes = V2.printTimes+, environmentGetCPUTime = V2.getCPUTime+, environmentGetRealTime = V2.getRealTime+, environmentWrite = V2.write+, environmentWriteTransient = V2.writeTransient+, environmentWithFailColor = V2.withFailColor+, environmentWithSuccessColor = V2.withSuccessColor+, environmentWithPendingColor = V2.withPendingColor+, environmentWithInfoColor = V2.withInfoColor+, environmentUseDiff = V2.useDiff+, environmentExtraChunk = V2.extraChunk+, environmentMissingChunk = V2.missingChunk+, environmentLiftIO = liftIO }  silent :: Formatter
+ src/Test/Hspec/Core/Formatters/V1/Free.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveFunctor #-}+module Test.Hspec.Core.Formatters.V1.Free where++import           Prelude ()+import           Test.Hspec.Core.Compat++data Free f a = Free (f (Free f a)) | Pure a+  deriving Functor++instance Functor f => Applicative (Free f) where+  pure = Pure+  Pure f <*> Pure a = Pure (f a)+  Pure f <*> Free m = Free (fmap f <$> m)+  Free m <*> b = Free (fmap (<*> b) m)++instance Functor f => Monad (Free f) where+  return = pure+  Pure a >>= f = f a+  Free m >>= f = Free (fmap (>>= f) m)++liftF :: Functor f => f a -> Free f a+liftF command = Free (fmap Pure command)
+ src/Test/Hspec/Core/Formatters/V1/Monad.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+module Test.Hspec.Core.Formatters.V1.Monad (+  Formatter(..)+, Item(..)+, Result(..)+, FailureReason (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages+, usedSeed++, printTimes+, getCPUTime+, getRealTime++, write+, writeLine+, writeTransient++, withInfoColor+, withSuccessColor+, withPendingColor+, withFailColor++, useDiff+, extraChunk+, missingChunk++, Environment(..)+, interpretWith+) where++import           Prelude ()+import           Test.Hspec.Core.Compat++import           Control.Monad.IO.Class++import           Test.Hspec.Core.Formatters.V1.Free+import           Test.Hspec.Core.Clock+import           Test.Hspec.Core.Format++data Formatter = Formatter {++  headerFormatter :: FormatM ()++-- | evaluated before each test group+, exampleGroupStarted :: [String] -> String -> FormatM ()++-- | evaluated after each test group+, exampleGroupDone :: FormatM ()++-- | evaluated before each example+, exampleStarted :: Path -> FormatM ()++-- | used to notify the progress of the currently evaluated example+, exampleProgress :: Path -> Progress -> FormatM ()++-- | evaluated after each successful example+, exampleSucceeded :: Path -> String -> FormatM ()++-- | evaluated after each failed example+, exampleFailed :: Path -> String -> FailureReason -> FormatM ()++-- | evaluated after each pending example+, examplePending :: Path -> String -> Maybe String -> FormatM ()++-- | evaluated after a test run+, failedFormatter :: FormatM ()++-- | evaluated after `failedFormatter`+, footerFormatter :: FormatM ()+}++data FailureRecord = FailureRecord {+  failureRecordLocation :: Maybe Location+, failureRecordPath     :: Path+, failureRecordMessage  :: FailureReason+}++data FormatF next =+    GetSuccessCount (Int -> next)+  | GetPendingCount (Int -> next)+  | GetFailMessages ([FailureRecord] -> next)+  | UsedSeed (Integer -> next)+  | PrintTimes (Bool -> next)+  | GetCPUTime (Maybe Seconds -> next)+  | GetRealTime (Seconds -> next)+  | Write String next+  | WriteTransient String next+  | forall a. WithFailColor (FormatM a) (a -> next)+  | forall a. WithSuccessColor (FormatM a) (a -> next)+  | forall a. WithPendingColor (FormatM a) (a -> next)+  | forall a. WithInfoColor (FormatM a) (a -> next)+  | UseDiff (Bool -> next)+  | ExtraChunk String next+  | MissingChunk String next+  | forall a. LiftIO (IO a) (a -> next)++instance Functor FormatF where -- deriving this instance would require GHC >= 7.10.1+  fmap f x = case x of+    GetSuccessCount next -> GetSuccessCount (fmap f next)+    GetPendingCount next -> GetPendingCount (fmap f next)+    GetFailMessages next -> GetFailMessages (fmap f next)+    UsedSeed next -> UsedSeed (fmap f next)+    PrintTimes next -> PrintTimes (fmap f next)+    GetCPUTime next -> GetCPUTime (fmap f next)+    GetRealTime next -> GetRealTime (fmap f next)+    Write s next -> Write s (f next)+    WriteTransient s next -> WriteTransient s (f next)+    WithFailColor action next -> WithFailColor action (fmap f next)+    WithSuccessColor action next -> WithSuccessColor action (fmap f next)+    WithPendingColor action next -> WithPendingColor action (fmap f next)+    WithInfoColor action next -> WithInfoColor action (fmap f next)+    UseDiff next -> UseDiff (fmap f next)+    ExtraChunk s next -> ExtraChunk s (f next)+    MissingChunk s next -> MissingChunk s (f next)+    LiftIO action next -> LiftIO action (fmap f next)++type FormatM = Free FormatF++instance MonadIO FormatM where+  liftIO s = liftF (LiftIO s id)++data Environment m = Environment {+  environmentGetSuccessCount :: m Int+, environmentGetPendingCount :: m Int+, environmentGetFailMessages :: m [FailureRecord]+, environmentUsedSeed :: m Integer+, environmentPrintTimes :: m Bool+, environmentGetCPUTime :: m (Maybe Seconds)+, environmentGetRealTime :: m Seconds+, environmentWrite :: String -> m ()+, environmentWriteTransient :: String -> m ()+, environmentWithFailColor :: forall a. m a -> m a+, environmentWithSuccessColor :: forall a. m a -> m a+, environmentWithPendingColor :: forall a. m a -> m a+, environmentWithInfoColor :: forall a. m a -> m a+, environmentUseDiff :: m Bool+, environmentExtraChunk :: String -> m ()+, environmentMissingChunk :: String -> m ()+, environmentLiftIO :: forall a. IO a -> m a+}++interpretWith :: forall m a. Monad m => Environment m -> FormatM a -> m a+interpretWith Environment{..} = go+  where+    go :: forall b. FormatM b -> m b+    go m = case m of+      Pure value -> return value+      Free action -> case action of+        GetSuccessCount next -> environmentGetSuccessCount >>= go . next+        GetPendingCount next -> environmentGetPendingCount >>= go . next+        GetFailMessages next -> environmentGetFailMessages >>= go . next+        UsedSeed next -> environmentUsedSeed >>= go . next+        PrintTimes next -> environmentPrintTimes >>= go . next+        GetCPUTime next -> environmentGetCPUTime >>= go . next+        GetRealTime next -> environmentGetRealTime >>= go . next+        Write s next -> environmentWrite s >> go next+        WriteTransient s next -> environmentWriteTransient s >> go next+        WithFailColor inner next -> environmentWithFailColor (go inner) >>= go . next+        WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next+        WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next+        WithInfoColor inner next -> environmentWithInfoColor (go inner) >>= go . next+        UseDiff next -> environmentUseDiff >>= go . next+        ExtraChunk s next -> environmentExtraChunk s >> go next+        MissingChunk s next -> environmentMissingChunk s >> go next+        LiftIO inner next -> environmentLiftIO inner >>= go . next++-- | Get the number of successful examples encountered so far.+getSuccessCount :: FormatM Int+getSuccessCount = liftF (GetSuccessCount id)++-- | Get the number of pending examples encountered so far.+getPendingCount :: FormatM Int+getPendingCount = liftF (GetPendingCount id)++-- | Get the number of failed examples encountered so far.+getFailCount :: FormatM Int+getFailCount = length <$> getFailMessages++-- | Get the total number of examples encountered so far.+getTotalCount :: FormatM Int+getTotalCount = sum <$> sequence [getSuccessCount, getFailCount, getPendingCount]++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [FailureRecord]+getFailMessages = liftF (GetFailMessages id)++-- | The random seed that is used for QuickCheck.+usedSeed :: FormatM Integer+usedSeed = liftF (UsedSeed id)++-- | Return `True` if the user requested time reporting for individual spec+-- items, `False` otherwise.+printTimes :: FormatM Bool+printTimes = liftF (PrintTimes id)++-- | Get the used CPU time since the test run has been started.+getCPUTime :: FormatM (Maybe Seconds)+getCPUTime = liftF (GetCPUTime id)++-- | Get the passed real time since the test run has been started.+getRealTime :: FormatM Seconds+getRealTime = liftF (GetRealTime id)++-- | Append some output to the report.+write :: String -> FormatM ()+write s = liftF (Write s ())++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = write s >> write "\n"++writeTransient :: String -> FormatM ()+writeTransient s = liftF (WriteTransient s ())++-- | Set output color to red, run given action, and finally restore the default+-- color.+withFailColor :: FormatM a -> FormatM a+withFailColor s = liftF (WithFailColor s id)++-- | Set output color to green, run given action, and finally restore the+-- default color.+withSuccessColor :: FormatM a -> FormatM a+withSuccessColor s = liftF (WithSuccessColor s id)++-- | Set output color to yellow, run given action, and finally restore the+-- default color.+withPendingColor :: FormatM a -> FormatM a+withPendingColor s = liftF (WithPendingColor s id)++-- | Set output color to cyan, run given action, and finally restore the+-- default color.+withInfoColor :: FormatM a -> FormatM a+withInfoColor s = liftF (WithInfoColor s id)++-- | Return `True` if the user requested colorized diffs, `False` otherwise.+useDiff :: FormatM Bool+useDiff = liftF (UseDiff id)++-- | Output given chunk in red.+extraChunk :: String -> FormatM ()+extraChunk s = liftF (ExtraChunk s ())++-- | Output given chunk in green.+missingChunk :: String -> FormatM ()+missingChunk s = liftF (MissingChunk s ())
src/Test/Hspec/Core/Formatters/V2.hs view
@@ -32,6 +32,7 @@ , getPendingCount , getFailCount , getTotalCount+, getExpectedTotalCount  , FailureRecord (..) , getFailMessages@@ -54,6 +55,8 @@ , withPendingColor , withFailColor +, outputUnicode+ , useDiff , extraChunk , missingChunk@@ -79,17 +82,19 @@ -- -- Everything imported here has to be re-exported, so that users can implement -- their own formatters.-import Test.Hspec.Core.Formatters.Monad (-    Formatter (..)+import Test.Hspec.Core.Formatters.Internal (+    Formatter(..)   , Item(..)   , Result(..)   , FailureReason (..)   , FormatM+  , formatterToFormat    , getSuccessCount   , getPendingCount   , getFailCount   , getTotalCount+  , getExpectedTotalCount    , FailureRecord (..)   , getFailMessages@@ -108,12 +113,13 @@   , withPendingColor   , withFailColor +  , outputUnicode+   , useDiff   , extraChunk   , missingChunk   ) -import           Test.Hspec.Core.Formatters.Internal (formatterToFormat) import           Test.Hspec.Core.Formatters.Diff  silent :: Formatter@@ -136,10 +142,12 @@     writeTransient $ indentationFor nesting ++ requirement ++ " [ ]"  , formatterItemDone = \ (nesting, requirement) item -> do+    unicode <- outputUnicode+    let fallback a b = if unicode then a else b     uncurry (writeResult nesting requirement (itemDuration item) (itemInfo item)) $ case itemResult item of-      Success {} -> (withSuccessColor, "✔")-      Pending {} -> (withPendingColor, "‐")-      Failure {} -> (withFailColor, "✘")+      Success {} -> (withSuccessColor, fallback "✔" "v")+      Pending {} -> (withPendingColor, fallback "‐" "-")+      Failure {} -> (withFailColor,    fallback "✘" "x")     case itemResult item of       Success {} -> return ()       Failure {} -> return ()
src/Test/Hspec/Core/Runner.hs view
@@ -11,6 +11,7 @@ -- * Config , Config (..) , ColorMode (..)+, UnicodeMode(..) , Path , defaultConfig , configAddFilter@@ -31,6 +32,7 @@ , rerunAll , specToEvalForest , colorOutputSupported+, unicodeOutputSupported #endif ) where @@ -213,20 +215,22 @@     Just n -> return n    useColor <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout)+  outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout    results <- withHiddenCursor useColor stdout $ do     let       formatConfig = FormatConfig {         formatConfigUseColor = useColor+      , formatConfigOutputUnicode = outputUnicode       , formatConfigUseDiff = configDiff config       , formatConfigPrintTimes = configTimes config       , formatConfigHtmlOutput = configHtmlOutput config       , formatConfigPrintCpuTime = configPrintCpuTime config       , formatConfigUsedSeed = seed-      , formatConfigItemCount = numberOfItems+      , formatConfigExpectedTotalCount = numberOfItems       } -      formatter = fromMaybe (V2.formatterToFormat V2.specdoc) (configFormat config <|> V1.formatterToFormat <$> configFormatter config)+      formatter = fromMaybe (V2.formatterToFormat V2.checks) (configFormat config <|> V1.formatterToFormat <$> configFormatter config)      format <- maybe id printSlowSpecItems (configPrintSlowItems config) <$> formatter formatConfig @@ -234,7 +238,7 @@       evalConfig = EvalConfig {         evalConfigFormat = format       , evalConfigConcurrentJobs = concurrentJobs-      , evalConfigFastFail = configFastFail config+      , evalConfigFailFast = configFailFast config       }     runFormatter evalConfig filteredSpec @@ -290,6 +294,12 @@   ColorAuto  -> (&&) <$> (not <$> noColor) <*> isTerminalDevice   ColorNever -> return False   ColorAlways -> return True++unicodeOutputSupported :: UnicodeMode -> Handle -> IO Bool+unicodeOutputSupported mode h = case mode of+  UnicodeAuto -> (== Just "UTF-8") . fmap show <$> hGetEncoding h+  UnicodeNever -> return False+  UnicodeAlways -> return True  noColor :: IO Bool noColor = lookupEnv "NO_COLOR" <&> (/= Nothing)
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -51,7 +51,7 @@ data EvalConfig = EvalConfig {   evalConfigFormat :: Format , evalConfigConcurrentJobs :: Int-, evalConfigFastFail :: Bool+, evalConfigFailFast :: Bool }  data Env = Env {@@ -210,7 +210,7 @@  run :: [RunningTree IO] -> EvalM () run specs = do-  fastFail <- asks (evalConfigFastFail . envConfig)+  fastFail <- asks (evalConfigFailFast . envConfig)   sequenceActions fastFail (concatMap foldSpec specs)   where     foldSpec :: RunningTree IO -> [EvalM ()]
test/Test/Hspec/Core/Formatters/V1Spec.hs view
@@ -12,8 +12,8 @@ import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H import qualified Test.Hspec.Core.Formatters.V1 as H-import qualified Test.Hspec.Core.Formatters.Monad as H (interpretWith)-import           Test.Hspec.Core.Formatters.Monad (FormatM, Environment(..), FailureRecord(..), FailureReason(..))+import qualified Test.Hspec.Core.Formatters.V1.Monad as H (interpretWith)+import           Test.Hspec.Core.Formatters.V1.Monad (FormatM, Environment(..), FailureRecord(..), FailureReason(..))  data ColorizedText =     Plain String@@ -65,7 +65,6 @@   environmentGetSuccessCount = return 0 , environmentGetPendingCount = return 0 , environmentGetFailMessages = return []-, environmentGetFinalCount = return 0 , environmentUsedSeed = return 0 , environmentGetCPUTime = return Nothing , environmentGetRealTime = return 0@@ -178,7 +177,7 @@         , "2 examples, 0 failures"         ] -    it "displays a row for each successfull, failed, or pending example" $ do+    it "displays a row for each successful, failed, or pending example" $ do       r <- runSpec testSpec       r `shouldSatisfy` any (== "  fail 1 FAILED [1]")       r `shouldSatisfy` any (== "  success")
test/Test/Hspec/Core/Formatters/V2Spec.hs view
@@ -6,93 +6,13 @@  import           Prelude () import           Helper-import           Data.String-import           Control.Monad.IO.Class-import           Control.Monad.Trans.Writer import qualified Control.Exception as E  import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Spec as Spec import qualified Test.Hspec.Core.Runner as H-import qualified Test.Hspec.Core.Formatters.V2 as H-import qualified Test.Hspec.Core.Formatters.V2 as Formatter-import qualified Test.Hspec.Core.Formatters.Monad as H-import           Test.Hspec.Core.Formatters.Monad (FormatM, Environment(..))--data Colorized a =-    Plain a-  | Transient a-  | Info a-  | Succeeded a-  | Failed a-  | Pending a-  | Extra a-  | Missing a-  deriving (Functor, Eq, Show)--instance IsString (Colorized String) where-  fromString = Plain--removeColors :: [Colorized String] -> String-removeColors input = case input of-  Plain x : xs -> x ++ removeColors xs-  Transient _ : xs -> removeColors xs-  Info x : xs -> x ++ removeColors xs-  Succeeded x : xs -> x ++ removeColors xs-  Failed x : xs -> x ++ removeColors xs-  Pending x : xs -> x ++ removeColors xs-  Extra x : xs -> x ++ removeColors xs-  Missing x : xs -> x ++ removeColors xs-  [] -> ""--simplify :: [Colorized String] -> [Colorized String]-simplify input = case input of-  Plain xs : Plain ys : zs -> simplify (Plain (xs ++ ys) : zs)-  Extra xs : Extra ys : zs -> simplify (Extra (xs ++ ys) : zs)-  Missing xs : Missing ys : zs -> simplify (Missing (xs ++ ys) : zs)-  x : xs -> x : simplify xs-  [] -> []--colorize :: (String -> Colorized String) -> [Colorized String] -> [Colorized String]-colorize color input = case simplify input of-  Plain x : xs -> color x : xs-  xs -> xs--interpret :: FormatM a -> IO [Colorized String]-interpret = interpretWith environment--interpretWith :: Environment (WriterT [Colorized String] IO) -> FormatM a -> IO [Colorized String]-interpretWith env = fmap simplify . execWriterT . H.interpretWith env--environment :: Environment (WriterT [Colorized String] IO)-environment = Environment {-  environmentGetSuccessCount = return 0-, environmentGetPendingCount = return 0-, environmentGetFailMessages = return []-, environmentGetFinalCount = return 0-, environmentUsedSeed = return 0-, environmentGetCPUTime = return Nothing-, environmentGetRealTime = return 0-, environmentWrite = tell . return . Plain-, environmentWriteTransient = tell . return . Transient-, environmentWithFailColor = \ action -> do-    (a, r) <- liftIO $ runWriterT action-    tell (colorize Failed r) >> return a-, environmentWithSuccessColor = \ action -> do-    (a, r) <- liftIO $ runWriterT action-    tell (colorize Succeeded r) >> return a-, environmentWithPendingColor = \ action -> do-    (a, r) <- liftIO $ runWriterT action-    tell (colorize Pending r) >> return a-, environmentWithInfoColor = \ action -> do-    (a, r) <- liftIO $ runWriterT action-    tell (colorize Info r) >> return a-, environmentUseDiff = return True-, environmentPrintTimes = return False-, environmentExtraChunk = tell . return . Extra-, environmentMissingChunk = tell . return . Missing-, environmentLiftIO = liftIO-}+import           Test.Hspec.Core.Format+import           Test.Hspec.Core.Formatters.V2  testSpec :: H.Spec testSpec = do@@ -104,33 +24,74 @@     H.it "exceptions" (undefined :: Spec.Result)     H.it "fail 3"     (H.Result "" $ Spec.Failure Nothing H.NoReason) ++formatConfig :: FormatConfig+formatConfig = FormatConfig {+  formatConfigUseColor = False+, formatConfigOutputUnicode = True+, formatConfigUseDiff = True+, formatConfigPrintTimes = False+, formatConfigHtmlOutput = False+, formatConfigPrintCpuTime = False+, formatConfigUsedSeed = 0+, formatConfigExpectedTotalCount = 0+}++runSpecWith :: Formatter -> H.Spec -> IO [String]+runSpecWith formatter = captureLines . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ formatterToFormat formatter}+ spec :: Spec spec = do-  describe "progress" $ do-    let formatter = H.progress-        item = Formatter.Item Nothing 0 ""+  let item = ItemDone ([], "") . Item Nothing 0 "" +  describe "progress" $ do     describe "formatterItemDone" $ do       it "marks succeeding examples with ." $ do-        interpret (H.formatterItemDone formatter undefined (item Formatter.Success)) `shouldReturn` [-            Succeeded "."-          ]+        formatter <- formatterToFormat progress formatConfig+        captureLines (formatter $ item Success)+          `shouldReturn` ["."]        it "marks failing examples with F" $ do-        interpret (H.formatterItemDone formatter undefined (item $ Formatter.Failure Nothing H.NoReason)) `shouldReturn` [-            Failed "F"-          ]+        formatter <- formatterToFormat progress formatConfig+        captureLines (formatter . item $ Failure Nothing NoReason)+          `shouldReturn` ["F"]        it "marks pending examples with ." $ do-        interpret (H.formatterItemDone formatter undefined (item $ Formatter.Pending Nothing Nothing)) `shouldReturn` [-            Pending "."-          ]+        formatter <- formatterToFormat progress formatConfig+        captureLines (formatter . item $ Pending Nothing Nothing)+          `shouldReturn` ["."] -  describe "specdoc" $ do+  describe "checks" $ do     let-      formatter = H.specdoc-      runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ H.formatterToFormat formatter}+      formatter = checks+      config = H.defaultConfig { H.configFormat = Just $ formatterToFormat formatter } +    it "" $ do+      r <- captureLines . H.hspecWithResult config $ do+        H.it "foo" True+      normalizeSummary r `shouldBe` [+          ""+        , "foo [✔]"+        , ""+        , "Finished in 0.0000 seconds"+        , "1 example, 0 failures"+        ]++    it "" $ do+      r <- captureLines . H.hspecWithResult config { H.configUnicodeMode = H.UnicodeNever } $ do+        H.it "foo" True+      normalizeSummary r `shouldBe` [+          ""+        , "foo [v]"+        , ""+        , "Finished in 0.0000 seconds"+        , "1 example, 0 failures"+        ]++  describe "specdoc" $ do++    let runSpec = runSpecWith specdoc+     it "displays a header for each thing being described" $ do       _:x:_ <- runSpec testSpec       x `shouldBe` "Example"@@ -181,7 +142,7 @@         , "2 examples, 0 failures"         ] -    it "displays a row for each successfull, failed, or pending example" $ do+    it "displays a row for each successful, failed, or pending example" $ do       r <- runSpec testSpec       r `shouldSatisfy` any (== "  fail 1 FAILED [1]")       r `shouldSatisfy` any (== "  success")@@ -212,15 +173,11 @@           ]      describe "formatterDone" $ do-      let action = H.formatterDone formatter-       context "when actual/expected contain newlines" $ do-        let-          env = environment {-            environmentGetFailMessages = return [H.FailureRecord Nothing ([], "") (H.ExpectedButGot Nothing "first\nsecond\nthird" "first\ntwo\nthird")]-            }         it "adds indentation" $ do-          (removeColors <$> interpretWith env action) `shouldReturn` unlines [+          formatter <- formatterToFormat progress formatConfig+          _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Failure Nothing $ ExpectedButGot Nothing "first\nsecond\nthird" "first\ntwo\nthird"+          (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [               ""             , "Failures:"             , ""@@ -241,73 +198,38 @@             ]        context "without failures" $ do-        let env = environment {environmentGetSuccessCount = return 1}         it "shows summary in green if there are no failures" $ do-          interpretWith env action `shouldReturn` [-              "\nFinished in 0.0000 seconds\n"-            , Succeeded "1 example, 0 failures\n"+          formatter <- formatterToFormat progress formatConfig+          _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Success+          (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [+              ""+            , "Finished in 0.0000 seconds"+            , "1 example, 0 failures"             ]        context "with pending examples" $ do-        let env = environment {environmentGetPendingCount = return 1}         it "shows summary in yellow if there are pending examples" $ do-          interpretWith env action `shouldReturn` [-             "\nFinished in 0.0000 seconds\n"-            , Pending "1 example, 0 failures, 1 pending\n"-            ]--      context "with failures" $ do-        let env = environment {environmentGetFailMessages = return [H.FailureRecord Nothing ([], "") H.NoReason]}-        it "shows summary in red" $ do-          interpretWith env action `shouldReturn` [-              Plain $ unlines [+          formatter <- formatterToFormat progress formatConfig+          _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Pending Nothing Nothing+          (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [               ""-            , "Failures:"-            , ""-            , "  1) "-            , ""-            , "  To rerun use: --match \"//\""-            , ""-            , "Randomized with seed 0"-            , ""             , "Finished in 0.0000 seconds"-            ]-            , Failed "1 example, 1 failure\n"-            ]--      context "with both failures and pending examples" $ do-        let env = environment {environmentGetFailMessages = return [H.FailureRecord Nothing ([], "") H.NoReason], environmentGetPendingCount = return 1}-        it "shows summary in red" $ do-          interpretWith env action `shouldReturn` [-              Plain $ unlines [-              ""-            , "Failures:"-            , ""-            , "  1) "-            , ""-            , "  To rerun use: --match \"//\""-            , ""-            , "Randomized with seed 0"-            , ""-            , "Finished in 0.0000 seconds"-            ]-            , Failed "2 examples, 1 failure, 1 pending\n"+            , "1 example, 0 failures, 1 pending"             ]      context "same as failed_examples" $ do-      failed_examplesSpec formatter+      failed_examplesSpec specdoc -  describe "additional formatter features" $ do-    describe "getFinalCount" $ do-      let formatter = H.silent {H.formatterDone = fmap show H.getFinalCount >>= H.writeLine}-          runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ H.formatterToFormat formatter}-      it "counts examples" $ do-        result:_ <- runSpec testSpec-        result `shouldBe` "6"+  describe "getExpectedTotalCount" $ do+    let formatter = silent { formatterStarted = fmap show getExpectedTotalCount >>= writeLine }+        runSpec = runSpecWith formatter+    it "returns the total number of spec items" $ do+      result:_ <- runSpec testSpec+      result `shouldBe` "6" -failed_examplesSpec :: H.Formatter -> Spec+failed_examplesSpec :: Formatter -> Spec failed_examplesSpec formatter = do-  let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormat = Just $ H.formatterToFormat formatter}+  let runSpec = runSpecWith formatter    context "displays a detailed list of failures" $ do     it "prints all requirements that are not met" $ do
test/Test/Hspec/Core/HooksSpec.hs view
@@ -23,7 +23,7 @@     config = EvalConfig {       evalConfigFormat = \ _ -> return ()     , evalConfigConcurrentJobs = 1-    , evalConfigFastFail = False+    , evalConfigFailFast = False     }     normalize = map $ \ (path, item) -> (pathToList path, normalizeItem item)     normalizeItem item = item {
test/Test/Hspec/Core/RunnerSpec.hs view
@@ -12,7 +12,7 @@ import           Prelude () import           Helper -import           System.IO (stderr)+import           System.IO import           System.Environment (withArgs, withProgName, getArgs) import           System.Exit import           Control.Concurrent@@ -193,7 +193,7 @@         r <- takeMVar mvar         normalizeSummary r `shouldBe` [             ""-          , "foo FAILED [1]"+          , "foo [✘]"           , ""           , "Failures:"           , ""@@ -228,8 +228,8 @@           H.it "bar" True         normalizeSummary r `shouldBe` [             ""-          , "foo"-          , "bar"+          , "foo [✔]"+          , "bar [✔]"           , ""           , "Finished in 0.0000 seconds"           , "2 examples, 0 failures"@@ -271,7 +271,7 @@           H.fit "bar" True         normalizeSummary r `shouldBe` [             ""-          , "bar FAILED [1]"+          , "bar [✘]"           , ""           , "Failures:"           , ""@@ -294,8 +294,8 @@           H.it "baz" False         normalizeSummary r `shouldBe` [             ""-          , "foo"-          , "bar FAILED [1]"+          , "foo [✔]"+          , "bar [✘]"           , ""           , "Failures:"           , ""@@ -335,7 +335,7 @@         normalizeSummary r `shouldBe` [             ""           , "foo"-          , "  bar FAILED [1]"+          , "  bar [✘]"           , ""           , "Failures:"           , ""@@ -418,7 +418,7 @@           H.it "foo" $ threadDelay 2000         normalizeTimes (normalizeSummary r) `shouldBe` [             ""-          , "foo"+          , "foo [✔]"           , ""           , "Finished in 0.0000 seconds"           , "1 example, 0 failures"@@ -502,17 +502,17 @@       it "marks successful examples with CSS class hspec-success" $ do         r <- capture_ . withArgs ["--html"] . H.hspec $ do           H.it "foo" True-        r `shouldContain` "<span class=\"hspec-success\">foo\n</span>"+        r `shouldContain` "foo [<span class=\"hspec-success\">✔</span>]\n"        it "marks pending examples with CSS class hspec-pending" $ do         r <- capture_ . withArgs ["--html"] . H.hspec $ do           H.it "foo" H.pending-        r `shouldContain` "<span class=\"hspec-pending\">foo"+        r `shouldContain` "foo [<span class=\"hspec-pending\">‐</span>]\n"        it "marks failed examples with CSS class hspec-failure" $ do         r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do           H.it "foo" False-        r `shouldContain` "<span class=\"hspec-failure\">foo"+        r `shouldContain` "foo [<span class=\"hspec-failure\">✘</span>]\n"    describe "hspecResult" $ do     let@@ -590,6 +590,30 @@         it "returns False" $ do           withEnvironment [("NO_COLOR", "yes")] $ do             H.colorOutputSupported H.ColorAuto isTerminalDevice `shouldReturn` False++  describe "colorOutputSupported" $ do+    context "with UnicodeAlways" $ do+      it "returns True" $ do+        H.unicodeOutputSupported H.UnicodeAlways undefined `shouldReturn` True++    context "with UnicodeNever" $ do+      it "returns False" $ do+        H.unicodeOutputSupported H.UnicodeNever undefined `shouldReturn` False++    context "with UnicodeAuto" $ do+      context "when file encoding is UTF-8" $ do+        it "returns True" $ do+          inTempDirectory $ do+            withFile "foo" WriteMode $ \ h -> do+              hSetEncoding h utf8+              H.unicodeOutputSupported H.UnicodeAuto h `shouldReturn` True++      context "when file encoding is not UTF-8" $ do+        it "returns False" $ do+          inTempDirectory $ do+            withFile "foo" WriteMode $ \ h -> do+              hSetEncoding h latin1+              H.unicodeOutputSupported H.UnicodeAuto h `shouldReturn` False    describe "rerunAll" $ do     let
version.yaml view
@@ -1,1 +1,1 @@-&version 2.8.5+&version 2.9.0