{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Runner (
hspec
, runSpec
, Config (..)
, ColorMode (..)
, Path
, defaultConfig
, configAddFilter
, readConfig
, Summary (..)
, isSuccess
, evaluateSummary
, hspecWith
, hspecResult
, hspecWithResult
#ifdef TEST
, rerunAll
#endif
) where
import Prelude ()
import Test.Hspec.Core.Compat
import Data.Maybe
import System.IO
import System.Environment (getArgs, withArgs)
import System.Exit
import qualified Control.Exception as E
import System.Console.ANSI (hHideCursor, hShowCursor)
import qualified Test.QuickCheck as QC
import Test.Hspec.Core.Util (Path)
import Test.Hspec.Core.Spec
import Test.Hspec.Core.Config
import Test.Hspec.Core.Formatters
import Test.Hspec.Core.Formatters.Internal
import Test.Hspec.Core.FailureReport
import Test.Hspec.Core.QuickCheckUtil
import Test.Hspec.Core.Runner.Eval
filterSpecs :: Config -> [EvalTree] -> [EvalTree]
filterSpecs :: Config -> [EvalTree] -> [EvalTree]
filterSpecs Config
c = [String] -> [EvalTree] -> [EvalTree]
go []
where
p :: Path -> Bool
p :: Path -> Bool
p Path
path = ((Path -> Bool) -> Maybe (Path -> Bool) -> Path -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Path -> Bool
forall a b. a -> b -> a
const Bool
True) (Config -> Maybe (Path -> Bool)
configFilterPredicate Config
c) Path
path) Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Path -> Bool) -> Maybe (Path -> Bool) -> Path -> Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> Path -> Bool
forall a b. a -> b -> a
const Bool
False) (Config -> Maybe (Path -> Bool)
configSkipPredicate Config
c) Path
path)
go :: [String] -> [EvalTree] -> [EvalTree]
go :: [String] -> [EvalTree] -> [EvalTree]
go [String]
groups = (EvalTree -> Maybe EvalTree) -> [EvalTree] -> [EvalTree]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([String] -> EvalTree -> Maybe EvalTree
goSpec [String]
groups)
goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b
goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b
goSpecs [String]
groups [EvalTree]
specs [EvalTree] -> b
ctor = case [String] -> [EvalTree] -> [EvalTree]
go [String]
groups [EvalTree]
specs of
[] -> Maybe b
forall a. Maybe a
Nothing
[EvalTree]
xs -> b -> Maybe b
forall a. a -> Maybe a
Just ([EvalTree] -> b
ctor [EvalTree]
xs)
goSpec :: [String] -> EvalTree -> Maybe (EvalTree)
goSpec :: [String] -> EvalTree -> Maybe EvalTree
goSpec [String]
groups EvalTree
spec = case EvalTree
spec of
Leaf EvalItem
item -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Path -> Bool
p ([String]
groups, EvalItem -> String
evalItemDescription EvalItem
item)) Maybe () -> Maybe EvalTree -> Maybe EvalTree
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalTree -> Maybe EvalTree
forall (m :: * -> *) a. Monad m => a -> m a
return EvalTree
spec
Node String
group [EvalTree]
specs -> [String]
-> [EvalTree] -> ([EvalTree] -> EvalTree) -> Maybe EvalTree
forall b. [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b
goSpecs ([String]
groups [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
group]) [EvalTree]
specs (String -> [EvalTree] -> EvalTree
forall c a. String -> [Tree c a] -> Tree c a
Node String
group)
NodeWithCleanup IO ()
action [EvalTree]
specs -> [String]
-> [EvalTree] -> ([EvalTree] -> EvalTree) -> Maybe EvalTree
forall b. [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b
goSpecs [String]
groups [EvalTree]
specs (IO () -> [EvalTree] -> EvalTree
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup IO ()
action)
applyDryRun :: Config -> [SpecTree ()] -> [SpecTree ()]
applyDryRun :: Config -> [SpecTree ()] -> [SpecTree ()]
applyDryRun Config
c
| Config -> Bool
configDryRun Config
c = (SpecTree () -> SpecTree ()) -> [SpecTree ()] -> [SpecTree ()]
forall a b. (a -> b) -> [a] -> [b]
map (SpecTree () -> SpecTree ()
removeCleanup (SpecTree () -> SpecTree ())
-> (SpecTree () -> SpecTree ()) -> SpecTree () -> SpecTree ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item () -> Item ()) -> SpecTree () -> SpecTree ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Item () -> Item ()
markSuccess)
| Bool
otherwise = [SpecTree ()] -> [SpecTree ()]
forall a. a -> a
id
where
markSuccess :: Item () -> Item ()
markSuccess :: Item () -> Item ()
markSuccess Item ()
item = Item ()
item {itemExample :: Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
itemExample = Result
-> Params
-> (ActionWith (Arg Result) -> IO ())
-> ProgressCallback
-> IO Result
forall e.
Example e =>
e
-> Params
-> (ActionWith (Arg e) -> IO ())
-> ProgressCallback
-> IO Result
safeEvaluateExample (String -> ResultStatus -> Result
Result String
"" ResultStatus
Success)}
removeCleanup :: SpecTree () -> SpecTree ()
removeCleanup :: SpecTree () -> SpecTree ()
removeCleanup SpecTree ()
spec = case SpecTree ()
spec of
Node String
x [SpecTree ()]
xs -> String -> [SpecTree ()] -> SpecTree ()
forall c a. String -> [Tree c a] -> Tree c a
Node String
x ((SpecTree () -> SpecTree ()) -> [SpecTree ()] -> [SpecTree ()]
forall a b. (a -> b) -> [a] -> [b]
map SpecTree () -> SpecTree ()
removeCleanup [SpecTree ()]
xs)
NodeWithCleanup ActionWith ()
_ [SpecTree ()]
xs -> ActionWith () -> [SpecTree ()] -> SpecTree ()
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup (\() -> ActionWith ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ((SpecTree () -> SpecTree ()) -> [SpecTree ()] -> [SpecTree ()]
forall a b. (a -> b) -> [a] -> [b]
map SpecTree () -> SpecTree ()
removeCleanup [SpecTree ()]
xs)
leaf :: SpecTree ()
leaf@(Leaf Item ()
_) -> SpecTree ()
leaf
hspec :: Spec -> IO ()
hspec :: Spec -> IO ()
hspec Spec
spec =
IO [String]
getArgs
IO [String] -> ([String] -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
defaultConfig
IO Config -> (Config -> IO Summary) -> IO Summary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Summary -> IO Summary
forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples (IO Summary -> IO Summary)
-> (Config -> IO Summary) -> Config -> IO Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec
IO Summary -> (Summary -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Summary -> IO ()
evaluateSummary
ensureSeed :: Config -> IO Config
ensureSeed :: Config -> IO Config
ensureSeed Config
c = case Config -> Maybe Integer
configQuickCheckSeed Config
c of
Maybe Integer
Nothing -> do
Int
seed <- IO Int
newSeed
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c {configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed)}
Maybe Integer
_ -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c
hspecWith :: Config -> Spec -> IO ()
hspecWith :: Config -> Spec -> IO ()
hspecWith Config
config Spec
spec = IO [String]
getArgs IO [String] -> ([String] -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
config IO Config -> (Config -> IO Summary) -> IO Summary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Summary -> IO Summary
forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples (IO Summary -> IO Summary)
-> (Config -> IO Summary) -> Config -> IO Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec IO Summary -> (Summary -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Summary -> IO ()
evaluateSummary
isSuccess :: Summary -> Bool
isSuccess :: Summary -> Bool
isSuccess Summary
summary = Summary -> Int
summaryFailures Summary
summary Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
evaluateSummary :: Summary -> IO ()
evaluateSummary :: Summary -> IO ()
evaluateSummary Summary
summary = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Summary -> Bool
isSuccess Summary
summary) IO ()
forall a. IO a
exitFailure
hspecResult :: Spec -> IO Summary
hspecResult :: Spec -> IO Summary
hspecResult Spec
spec = IO [String]
getArgs IO [String] -> ([String] -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
defaultConfig IO Config -> (Config -> IO Summary) -> IO Summary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Summary -> IO Summary
forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples (IO Summary -> IO Summary)
-> (Config -> IO Summary) -> Config -> IO Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec
hspecWithResult :: Config -> Spec -> IO Summary
hspecWithResult :: Config -> Spec -> IO Summary
hspecWithResult Config
config Spec
spec = IO [String]
getArgs IO [String] -> ([String] -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
config IO Config -> (Config -> IO Summary) -> IO Summary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Summary -> IO Summary
forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples (IO Summary -> IO Summary)
-> (Config -> IO Summary) -> Config -> IO Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec
runSpec :: Spec -> Config -> IO Summary
runSpec :: Spec -> Config -> IO Summary
runSpec Spec
spec Config
c_ = do
Maybe FailureReport
oldFailureReport <- Config -> IO (Maybe FailureReport)
readFailureReportOnRerun Config
c_
Config
c <- Config -> IO Config
ensureSeed (Maybe FailureReport -> Config -> Config
applyFailureReport Maybe FailureReport
oldFailureReport Config
c_)
if Config -> Bool
configRerunAllOnSuccess Config
c
then Config -> Maybe FailureReport -> IO Summary
rerunAllMode Config
c Maybe FailureReport
oldFailureReport
else Config -> IO Summary
normalMode Config
c
where
normalMode :: Config -> IO Summary
normalMode Config
c = Config -> Spec -> IO Summary
runSpec_ Config
c Spec
spec
rerunAllMode :: Config -> Maybe FailureReport -> IO Summary
rerunAllMode Config
c Maybe FailureReport
oldFailureReport = do
Summary
summary <- Config -> Spec -> IO Summary
runSpec_ Config
c Spec
spec
if Config -> Maybe FailureReport -> Summary -> Bool
rerunAll Config
c Maybe FailureReport
oldFailureReport Summary
summary
then Spec -> Config -> IO Summary
runSpec Spec
spec Config
c_
else Summary -> IO Summary
forall (m :: * -> *) a. Monad m => a -> m a
return Summary
summary
failFocused :: Item a -> Item a
failFocused :: Item a -> Item a
failFocused Item a
item = Item a
item {itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
itemExample = Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
example}
where
failure :: ResultStatus
failure = Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (String -> FailureReason
Reason String
"item is focused; failing due to --fail-on-focused")
example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
example
| Item a -> Bool
forall a. Item a -> Bool
itemIsFocused Item a
item = \ Params
params ActionWith a -> IO ()
hook ProgressCallback
p -> do
Result String
info ResultStatus
status <- Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item a
item Params
params ActionWith a -> IO ()
hook ProgressCallback
p
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> ResultStatus -> Result
Result String
info (ResultStatus -> Result) -> ResultStatus -> Result
forall a b. (a -> b) -> a -> b
$ case ResultStatus
status of
ResultStatus
Success -> ResultStatus
failure
Pending Maybe Location
_ Maybe String
_ -> ResultStatus
failure
Failure{} -> ResultStatus
status
| Bool
otherwise = Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item a
item
failFocusedItems :: Config -> Spec -> Spec
failFocusedItems :: Config -> Spec -> Spec
failFocusedItems Config
config Spec
spec
| Config -> Bool
configFailOnFocused Config
config = (Item () -> Item ()) -> Spec -> Spec
forall a. (Item a -> Item a) -> SpecWith a -> SpecWith a
mapSpecItem_ Item () -> Item ()
forall a. Item a -> Item a
failFocused Spec
spec
| Bool
otherwise = Spec
spec
focusSpec :: Config -> Spec -> Spec
focusSpec :: Config -> Spec -> Spec
focusSpec Config
config Spec
spec
| Config -> Bool
configFocusedOnly Config
config = Spec
spec
| Bool
otherwise = Spec -> Spec
forall a. SpecWith a -> SpecWith a
focus Spec
spec
runSpec_ :: Config -> Spec -> IO Summary
runSpec_ :: Config -> Spec -> IO Summary
runSpec_ Config
config Spec
spec = do
Config -> (Handle -> IO Summary) -> IO Summary
forall a. Config -> (Handle -> IO a) -> IO a
withHandle Config
config ((Handle -> IO Summary) -> IO Summary)
-> (Handle -> IO Summary) -> IO Summary
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
let formatter :: Formatter
formatter = Formatter -> Maybe Formatter -> Formatter
forall a. a -> Maybe a -> a
fromMaybe Formatter
specdoc (Config -> Maybe Formatter
configFormatter Config
config)
seed :: Integer
seed = (Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Integer -> Integer)
-> (Config -> Maybe Integer) -> Config -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe Integer
configQuickCheckSeed) Config
config
qcArgs :: Args
qcArgs = Config -> Args
configQuickCheckArgs Config
config
Int
concurrentJobs <- case Config -> Maybe Int
configConcurrentJobs Config
config of
Maybe Int
Nothing -> IO Int
getDefaultConcurrentJobs
Just Int
n -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
Bool
useColor <- Handle -> Config -> IO Bool
doesUseColor Handle
h Config
config
let
focusedSpec :: Spec
focusedSpec = Config -> Spec -> Spec
focusSpec Config
config (Config -> Spec -> Spec
failFocusedItems Config
config Spec
spec)
params :: Params
params = Args -> Int -> Params
Params (Config -> Args
configQuickCheckArgs Config
config) (Config -> Int
configSmallCheckDepth Config
config)
[EvalTree]
filteredSpec <- Config -> [EvalTree] -> [EvalTree]
filterSpecs Config
config ([EvalTree] -> [EvalTree])
-> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpecTree () -> Maybe EvalTree) -> [SpecTree ()] -> [EvalTree]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Params -> SpecTree () -> Maybe EvalTree
toEvalTree Params
params) ([SpecTree ()] -> [EvalTree])
-> ([SpecTree ()] -> [SpecTree ()]) -> [SpecTree ()] -> [EvalTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> [SpecTree ()] -> [SpecTree ()]
applyDryRun Config
config ([SpecTree ()] -> [EvalTree]) -> IO [SpecTree ()] -> IO [EvalTree]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Spec -> IO [SpecTree ()]
forall a. SpecWith a -> IO [SpecTree a]
runSpecM Spec
focusedSpec
(Int
total, [Path]
failures) <- Bool -> Handle -> IO (Int, [Path]) -> IO (Int, [Path])
forall a. Bool -> Handle -> IO a -> IO a
withHiddenCursor Bool
useColor Handle
h (IO (Int, [Path]) -> IO (Int, [Path]))
-> IO (Int, [Path]) -> IO (Int, [Path])
forall a b. (a -> b) -> a -> b
$ do
let
formatConfig :: FormatConfig
formatConfig = FormatConfig :: Handle -> Bool -> Bool -> Bool -> Bool -> Integer -> FormatConfig
FormatConfig {
formatConfigHandle :: Handle
formatConfigHandle = Handle
h
, formatConfigUseColor :: Bool
formatConfigUseColor = Bool
useColor
, formatConfigUseDiff :: Bool
formatConfigUseDiff = Config -> Bool
configDiff Config
config
, formatConfigHtmlOutput :: Bool
formatConfigHtmlOutput = Config -> Bool
configHtmlOutput Config
config
, formatConfigPrintCpuTime :: Bool
formatConfigPrintCpuTime = Config -> Bool
configPrintCpuTime Config
config
, formatConfigUsedSeed :: Integer
formatConfigUsedSeed = Integer
seed
}
evalConfig :: EvalConfig FormatM
evalConfig = EvalConfig :: forall (m :: * -> *). Format m -> Int -> Bool -> EvalConfig m
EvalConfig {
evalConfigFormat :: Format FormatM
evalConfigFormat = Formatter -> FormatConfig -> Format FormatM
formatterToFormat Formatter
formatter FormatConfig
formatConfig
, evalConfigConcurrentJobs :: Int
evalConfigConcurrentJobs = Int
concurrentJobs
, evalConfigFastFail :: Bool
evalConfigFastFail = Config -> Bool
configFastFail Config
config
}
EvalConfig FormatM -> [EvalTree] -> IO (Int, [Path])
forall (m :: * -> *).
MonadIO m =>
EvalConfig m -> [EvalTree] -> IO (Int, [Path])
runFormatter EvalConfig FormatM
evalConfig [EvalTree]
filteredSpec
Config -> Integer -> Args -> [Path] -> IO ()
dumpFailureReport Config
config Integer
seed Args
qcArgs [Path]
failures
Summary -> IO Summary
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Summary
Summary Int
total ([Path] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Path]
failures))
toEvalTree :: Params -> SpecTree () -> Maybe EvalTree
toEvalTree :: Params -> SpecTree () -> Maybe EvalTree
toEvalTree Params
params = SpecTree () -> Maybe EvalTree
forall c. Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
go
where
go :: Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
go :: Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
go Tree (() -> c) (Item ())
t = case Tree (() -> c) (Item ())
t of
Node String
s [Tree (() -> c) (Item ())]
xs -> Tree c EvalItem -> Maybe (Tree c EvalItem)
forall a. a -> Maybe a
Just (Tree c EvalItem -> Maybe (Tree c EvalItem))
-> Tree c EvalItem -> Maybe (Tree c EvalItem)
forall a b. (a -> b) -> a -> b
$ String -> [Tree c EvalItem] -> Tree c EvalItem
forall c a. String -> [Tree c a] -> Tree c a
Node String
s ((Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem))
-> [Tree (() -> c) (Item ())] -> [Tree c EvalItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
forall c. Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
go [Tree (() -> c) (Item ())]
xs)
NodeWithCleanup () -> c
c [Tree (() -> c) (Item ())]
xs -> Tree c EvalItem -> Maybe (Tree c EvalItem)
forall a. a -> Maybe a
Just (Tree c EvalItem -> Maybe (Tree c EvalItem))
-> Tree c EvalItem -> Maybe (Tree c EvalItem)
forall a b. (a -> b) -> a -> b
$ c -> [Tree c EvalItem] -> Tree c EvalItem
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup (() -> c
c ()) ((Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem))
-> [Tree (() -> c) (Item ())] -> [Tree c EvalItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
forall c. Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)
go [Tree (() -> c) (Item ())]
xs)
Leaf (Item String
requirement Maybe Location
loc Maybe Bool
isParallelizable Bool
isFocused Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
e) ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isFocused Maybe () -> Maybe (Tree c EvalItem) -> Maybe (Tree c EvalItem)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tree c EvalItem -> Maybe (Tree c EvalItem)
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalItem -> Tree c EvalItem
forall c a. a -> Tree c a
Leaf (String
-> Maybe Location
-> Bool
-> (ProgressCallback -> IO Result)
-> EvalItem
EvalItem String
requirement Maybe Location
loc (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
isParallelizable) (Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
e Params
params ((ActionWith () -> IO ()) -> ProgressCallback -> IO Result)
-> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
forall a b. (a -> b) -> a -> b
$ (ActionWith () -> ActionWith ()
forall a b. (a -> b) -> a -> b
$ ()))))
dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO ()
dumpFailureReport :: Config -> Integer -> Args -> [Path] -> IO ()
dumpFailureReport Config
config Integer
seed Args
qcArgs [Path]
xs = do
Config -> FailureReport -> IO ()
writeFailureReport Config
config FailureReport :: Integer -> Int -> Int -> Int -> [Path] -> FailureReport
FailureReport {
failureReportSeed :: Integer
failureReportSeed = Integer
seed
, failureReportMaxSuccess :: Int
failureReportMaxSuccess = Args -> Int
QC.maxSuccess Args
qcArgs
, failureReportMaxSize :: Int
failureReportMaxSize = Args -> Int
QC.maxSize Args
qcArgs
, failureReportMaxDiscardRatio :: Int
failureReportMaxDiscardRatio = Args -> Int
QC.maxDiscardRatio Args
qcArgs
, failureReportPaths :: [Path]
failureReportPaths = [Path]
xs
}
doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a
doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a
doNotLeakCommandLineArgumentsToExamples = [String] -> IO a -> IO a
forall a. [String] -> IO a -> IO a
withArgs []
withHiddenCursor :: Bool -> Handle -> IO a -> IO a
withHiddenCursor :: Bool -> Handle -> IO a -> IO a
withHiddenCursor Bool
useColor Handle
h
| Bool
useColor = IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
E.bracket_ (Handle -> IO ()
hHideCursor Handle
h) (Handle -> IO ()
hShowCursor Handle
h)
| Bool
otherwise = IO a -> IO a
forall a. a -> a
id
doesUseColor :: Handle -> Config -> IO Bool
doesUseColor :: Handle -> Config -> IO Bool
doesUseColor Handle
h Config
c = case Config -> ColorMode
configColorMode Config
c of
ColorMode
ColorAuto -> Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsTerminalDevice Handle
h IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isDumb)
ColorMode
ColorNever -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ColorMode
ColorAlways -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
withHandle :: Config -> (Handle -> IO a) -> IO a
withHandle :: Config -> (Handle -> IO a) -> IO a
withHandle Config
c Handle -> IO a
action = case Config -> Either Handle String
configOutputFile Config
c of
Left Handle
h -> Handle -> IO a
action Handle
h
Right String
path -> String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
WriteMode Handle -> IO a
action
rerunAll :: Config -> Maybe FailureReport -> Summary -> Bool
rerunAll :: Config -> Maybe FailureReport -> Summary -> Bool
rerunAll Config
_ Maybe FailureReport
Nothing Summary
_ = Bool
False
rerunAll Config
config (Just FailureReport
oldFailureReport) Summary
summary =
Config -> Bool
configRerunAllOnSuccess Config
config
Bool -> Bool -> Bool
&& Config -> Bool
configRerun Config
config
Bool -> Bool -> Bool
&& Summary -> Bool
isSuccess Summary
summary
Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> ([Path] -> Bool) -> [Path] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (FailureReport -> [Path]
failureReportPaths FailureReport
oldFailureReport)
isDumb :: IO Bool
isDumb :: IO Bool
isDumb = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dumb") (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"TERM"
data Summary = Summary {
Summary -> Int
summaryExamples :: Int
, Summary -> Int
summaryFailures :: Int
} deriving (Summary -> Summary -> Bool
(Summary -> Summary -> Bool)
-> (Summary -> Summary -> Bool) -> Eq Summary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Summary -> Summary -> Bool
$c/= :: Summary -> Summary -> Bool
== :: Summary -> Summary -> Bool
$c== :: Summary -> Summary -> Bool
Eq, Int -> Summary -> ShowS
[Summary] -> ShowS
Summary -> String
(Int -> Summary -> ShowS)
-> (Summary -> String) -> ([Summary] -> ShowS) -> Show Summary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Summary] -> ShowS
$cshowList :: [Summary] -> ShowS
show :: Summary -> String
$cshow :: Summary -> String
showsPrec :: Int -> Summary -> ShowS
$cshowsPrec :: Int -> Summary -> ShowS
Show)
instance Monoid Summary where
mempty :: Summary
mempty = Int -> Int -> Summary
Summary Int
0 Int
0
#if !MIN_VERSION_base(4,11,0)
(Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
#else
instance Semigroup Summary where
(Summary Int
x1 Int
x2) <> :: Summary -> Summary -> Summary
<> (Summary Int
y1 Int
y2) = Int -> Int -> Summary
Summary (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1) (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2)
#endif