{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Test.Hspec.Core.Runner (
hspec
, runSpec
, Config (..)
, ColorMode (..)
, UnicodeMode(..)
, Path
, defaultConfig
, configAddFilter
, readConfig
, Summary (..)
, isSuccess
, evaluateSummary
, hspecWith
, hspecResult
, hspecWithResult
#ifdef TEST
, rerunAll
, specToEvalForest
, colorOutputSupported
, unicodeOutputSupported
#endif
) where
import Prelude ()
import Test.Hspec.Core.Compat
import Data.Maybe
import System.IO
import System.Environment (getArgs, withArgs)
import System.Exit
import Control.Arrow
import qualified Control.Exception as E
import System.Random
import Control.Monad.ST
import Data.STRef
import System.Console.ANSI (hSupportsANSI)
import System.Console.ANSI (hHideCursor, hShowCursor)
import qualified Test.QuickCheck as QC
import Test.Hspec.Core.Util (Path)
import Test.Hspec.Core.Spec hiding (pruneTree, pruneForest)
import Test.Hspec.Core.Config
import Test.Hspec.Core.Format (FormatConfig(..))
import qualified Test.Hspec.Core.Formatters.V1 as V1
import qualified Test.Hspec.Core.Formatters.V2 as V2
import Test.Hspec.Core.FailureReport
import Test.Hspec.Core.QuickCheckUtil
import Test.Hspec.Core.Shuffle
import Test.Hspec.Core.Runner.PrintSlowSpecItems
import Test.Hspec.Core.Runner.Eval hiding (Tree(..))
import qualified Test.Hspec.Core.Runner.Eval as Eval
applyFilterPredicates :: Config -> [Tree c EvalItem] -> [Tree c EvalItem]
applyFilterPredicates :: forall c. Config -> [Tree c EvalItem] -> [Tree c EvalItem]
applyFilterPredicates Config
c = forall a c. ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
filterForestWithLabels [String] -> EvalItem -> Bool
p
where
include :: Path -> Bool
include :: Path -> Bool
include = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const Bool
True) (Config -> Maybe (Path -> Bool)
configFilterPredicate Config
c)
skip :: Path -> Bool
skip :: Path -> Bool
skip = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const Bool
False) (Config -> Maybe (Path -> Bool)
configSkipPredicate Config
c)
p :: [String] -> EvalItem -> Bool
p :: [String] -> EvalItem -> Bool
p [String]
groups EvalItem
item = Path -> Bool
include Path
path Bool -> Bool -> Bool
&& Bool -> Bool
not (Path -> Bool
skip Path
path)
where
path :: Path
path = ([String]
groups, EvalItem -> String
evalItemDescription EvalItem
item)
applyDryRun :: Config -> [EvalItemTree] -> [EvalItemTree]
applyDryRun :: Config -> [EvalItemTree] -> [EvalItemTree]
applyDryRun Config
c
| Config -> Bool
configDryRun Config
c = forall a b c d. (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
bimapForest IO () -> IO ()
removeCleanup EvalItem -> EvalItem
markSuccess
| Bool
otherwise = forall a. a -> a
id
where
removeCleanup :: IO () -> IO ()
removeCleanup :: IO () -> IO ()
removeCleanup IO ()
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
markSuccess :: EvalItem -> EvalItem
markSuccess :: EvalItem -> EvalItem
markSuccess EvalItem
item = EvalItem
item {evalItemAction :: ProgressCallback -> IO Result
evalItemAction = \ ProgressCallback
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ResultStatus -> Result
Result String
"" ResultStatus
Success}
hspec :: Spec -> IO ()
hspec :: Spec -> IO ()
hspec Spec
spec =
IO [String]
getArgs
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
defaultConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec
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
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c {configQuickCheckSeed :: Maybe Integer
configQuickCheckSeed = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seed)}
Maybe Integer
_ -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
config forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> Config -> IO Summary
runSpec Spec
spec 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 forall a. Eq a => a -> a -> Bool
== Int
0
evaluateSummary :: Summary -> IO ()
evaluateSummary :: Summary -> IO ()
evaluateSummary Summary
summary = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Summary -> Bool
isSuccess Summary
summary) forall a. IO a
exitFailure
hspecResult :: Spec -> IO Summary
hspecResult :: Spec -> IO Summary
hspecResult Spec
spec = IO [String]
getArgs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
defaultConfig forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [String] -> IO Config
readConfig Config
config forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples 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
config = forall a. SpecWith a -> IO [SpecTree a]
runSpecM Spec
spec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [SpecTree ()] -> IO Summary
runSpecForest Config
config
runSpecForest :: Config -> [SpecTree ()] -> IO Summary
runSpecForest :: Config -> [SpecTree ()] -> IO Summary
runSpecForest Config
c_ [SpecTree ()]
spec = 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 -> [SpecTree ()] -> IO Summary
runSpecForest_ Config
c [SpecTree ()]
spec
rerunAllMode :: Config -> Maybe FailureReport -> IO Summary
rerunAllMode Config
c Maybe FailureReport
oldFailureReport = do
Summary
summary <- Config -> [SpecTree ()] -> IO Summary
runSpecForest_ Config
c [SpecTree ()]
spec
if Config -> Maybe FailureReport -> Summary -> Bool
rerunAll Config
c Maybe FailureReport
oldFailureReport Summary
summary
then Config -> [SpecTree ()] -> IO Summary
runSpecForest Config
c_ [SpecTree ()]
spec
else forall (m :: * -> *) a. Monad m => a -> m a
return Summary
summary
runSpecForest_ :: Config -> [SpecTree ()] -> IO Summary
runSpecForest_ :: Config -> [SpecTree ()] -> IO Summary
runSpecForest_ Config
config [SpecTree ()]
spec = Config -> [EvalTree] -> IO Summary
runEvalTree Config
config (Config -> [SpecTree ()] -> [EvalTree]
specToEvalForest Config
config [SpecTree ()]
spec)
failFocused :: Item a -> Item a
failFocused :: forall a. 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 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
| forall a. Item a -> Bool
itemIsFocused Item a
item = \ Params
params ActionWith a -> IO ()
hook ProgressCallback
p -> do
Result String
info ResultStatus
status <- forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item a
item Params
params ActionWith a -> IO ()
hook ProgressCallback
p
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ResultStatus -> Result
Result String
info 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 = forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item a
item
failFocusedItems :: Config -> [SpecTree a] -> [SpecTree a]
failFocusedItems :: forall a. Config -> [SpecTree a] -> [SpecTree a]
failFocusedItems Config
config [SpecTree a]
spec
| Config -> Bool
configFailOnFocused Config
config = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Item a -> Item a
failFocused) [SpecTree a]
spec
| Bool
otherwise = [SpecTree a]
spec
focusSpec :: Config -> [SpecTree a] -> [SpecTree a]
focusSpec :: forall a. Config -> [SpecTree a] -> [SpecTree a]
focusSpec Config
config [SpecTree a]
spec
| Config -> Bool
configFocusedOnly Config
config = [SpecTree a]
spec
| Bool
otherwise = forall a. [SpecTree a] -> [SpecTree a]
focusForest [SpecTree a]
spec
runEvalTree :: Config -> [EvalTree] -> IO Summary
runEvalTree :: Config -> [EvalTree] -> IO Summary
runEvalTree Config
config [EvalTree]
spec = do
let
seed :: Integer
seed = (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe Integer
configQuickCheckSeed) Config
config
qcArgs :: Args
qcArgs = Config -> Args
configQuickCheckArgs Config
config
!numberOfItems :: Int
numberOfItems = forall c a. [Tree c a] -> Int
countSpecItems [EvalTree]
spec
Int
concurrentJobs <- case Config -> Maybe Int
configConcurrentJobs Config
config of
Maybe Int
Nothing -> IO Int
getDefaultConcurrentJobs
Just Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
(Bool
reportProgress, Bool
useColor) <- ColorMode -> IO Bool -> IO (Bool, Bool)
colorOutputSupported (Config -> ColorMode
configColorMode Config
config) (Handle -> IO Bool
hSupportsANSI Handle
stdout)
Bool
outputUnicode <- UnicodeMode -> Handle -> IO Bool
unicodeOutputSupported (Config -> UnicodeMode
configUnicodeMode Config
config) Handle
stdout
[(Path, Item)]
results <- forall a. Bool -> Handle -> IO a -> IO a
withHiddenCursor Bool
reportProgress Handle
stdout forall a b. (a -> b) -> a -> b
$ do
let
formatConfig :: FormatConfig
formatConfig = FormatConfig {
formatConfigUseColor :: Bool
formatConfigUseColor = Bool
useColor
, formatConfigReportProgress :: Bool
formatConfigReportProgress = Bool
reportProgress
, formatConfigOutputUnicode :: Bool
formatConfigOutputUnicode = Bool
outputUnicode
, formatConfigUseDiff :: Bool
formatConfigUseDiff = Config -> Bool
configDiff Config
config
, formatConfigPrettyPrint :: Bool
formatConfigPrettyPrint = Config -> Bool
configPrettyPrint Config
config
, formatConfigPrintTimes :: Bool
formatConfigPrintTimes = Config -> Bool
configTimes Config
config
, formatConfigHtmlOutput :: Bool
formatConfigHtmlOutput = Config -> Bool
configHtmlOutput Config
config
, formatConfigPrintCpuTime :: Bool
formatConfigPrintCpuTime = Config -> Bool
configPrintCpuTime Config
config
, formatConfigUsedSeed :: Integer
formatConfigUsedSeed = Integer
seed
, formatConfigExpectedTotalCount :: Int
formatConfigExpectedTotalCount = Int
numberOfItems
}
formatter :: FormatConfig -> IO Format
formatter = forall a. a -> Maybe a -> a
fromMaybe (Formatter -> FormatConfig -> IO Format
V2.formatterToFormat Formatter
V2.checks) (Config -> Maybe (FormatConfig -> IO Format)
configFormat Config
config forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Formatter -> FormatConfig -> IO Format
V1.formatterToFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Maybe Formatter
configFormatter Config
config)
Format
format <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Int -> Format -> Format
printSlowSpecItems (Config -> Maybe Int
configPrintSlowItems Config
config) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormatConfig -> IO Format
formatter FormatConfig
formatConfig
let
evalConfig :: EvalConfig
evalConfig = EvalConfig {
evalConfigFormat :: Format
evalConfigFormat = Format
format
, evalConfigConcurrentJobs :: Int
evalConfigConcurrentJobs = Int
concurrentJobs
, evalConfigFailFast :: Bool
evalConfigFailFast = Config -> Bool
configFailFast Config
config
}
EvalConfig -> [EvalTree] -> IO [(Path, Item)]
runFormatter EvalConfig
evalConfig [EvalTree]
spec
let failures :: [(Path, Item)]
failures = forall a. (a -> Bool) -> [a] -> [a]
filter (Path, Item) -> Bool
resultItemIsFailure [(Path, Item)]
results
Config -> Integer -> Args -> [Path] -> IO ()
dumpFailureReport Config
config Integer
seed Args
qcArgs (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path, Item)]
failures)
forall (m :: * -> *) a. Monad m => a -> m a
return Summary {
summaryExamples :: Int
summaryExamples = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, Item)]
results
, summaryFailures :: Int
summaryFailures = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Path, Item)]
failures
}
specToEvalForest :: Config -> [SpecTree ()] -> [EvalTree]
specToEvalForest :: Config -> [SpecTree ()] -> [EvalTree]
specToEvalForest Config
config =
forall a. Config -> [SpecTree a] -> [SpecTree a]
failFocusedItems Config
config
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. Config -> [SpecTree a] -> [SpecTree a]
focusSpec Config
config
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Params -> [SpecTree ()] -> [EvalItemTree]
toEvalItemForest Params
params
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Config -> [EvalItemTree] -> [EvalItemTree]
applyDryRun Config
config
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall c. Config -> [Tree c EvalItem] -> [Tree c EvalItem]
applyFilterPredicates Config
config
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall {c} {a}. [Tree c a] -> [Tree c a]
randomize
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall c a. [Tree c a] -> [Tree c a]
pruneForest
where
seed :: Integer
seed = (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe Integer
configQuickCheckSeed) Config
config
params :: Params
params = Args -> Int -> Params
Params (Config -> Args
configQuickCheckArgs Config
config) (Config -> Int
configSmallCheckDepth Config
config)
randomize :: [Tree c a] -> [Tree c a]
randomize
| Config -> Bool
configRandomize Config
config = forall c a. Integer -> [Tree c a] -> [Tree c a]
randomizeForest Integer
seed
| Bool
otherwise = forall a. a -> a
id
pruneForest :: [Tree c a] -> [Eval.Tree c a]
pruneForest :: forall c a. [Tree c a] -> [Tree c a]
pruneForest = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall c a. Tree c a -> Maybe (Tree c a)
pruneTree
pruneTree :: Tree c a -> Maybe (Eval.Tree c a)
pruneTree :: forall c a. Tree c a -> Maybe (Tree c a)
pruneTree Tree c a
node = case Tree c a
node of
Node String
group [Tree c a]
xs -> forall c a. String -> NonEmpty (Tree c a) -> Tree c a
Eval.Node String
group forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {c} {a}. [Tree c a] -> Maybe (NonEmpty (Tree c a))
prune [Tree c a]
xs
NodeWithCleanup Maybe Location
loc c
action [Tree c a]
xs -> forall c a. Maybe Location -> c -> NonEmpty (Tree c a) -> Tree c a
Eval.NodeWithCleanup Maybe Location
loc c
action forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {c} {a}. [Tree c a] -> Maybe (NonEmpty (Tree c a))
prune [Tree c a]
xs
Leaf a
item -> forall a. a -> Maybe a
Just (forall c a. a -> Tree c a
Eval.Leaf a
item)
where
prune :: [Tree c a] -> Maybe (NonEmpty (Tree c a))
prune = forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. [Tree c a] -> [Tree c a]
pruneForest
type EvalItemTree = Tree (IO ()) EvalItem
toEvalItemForest :: Params -> [SpecTree ()] -> [EvalItemTree]
toEvalItemForest :: Params -> [SpecTree ()] -> [EvalItemTree]
toEvalItemForest Params
params = forall a b c d. (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
bimapForest ActionWith () -> IO ()
withUnit Item () -> EvalItem
toEvalItem forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c. (a -> Bool) -> [Tree c a] -> [Tree c a]
filterForest forall a. Item a -> Bool
itemIsFocused
where
toEvalItem :: Item () -> EvalItem
toEvalItem :: Item () -> EvalItem
toEvalItem (Item String
requirement Maybe Location
loc Maybe Bool
isParallelizable Bool
_isFocused Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
e) = String
-> Maybe Location
-> Bool
-> (ProgressCallback -> IO Result)
-> EvalItem
EvalItem String
requirement Maybe Location
loc (forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
isParallelizable) (Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
e Params
params ActionWith () -> IO ()
withUnit)
withUnit :: ActionWith () -> IO ()
withUnit :: ActionWith () -> IO ()
withUnit ActionWith ()
action = ActionWith ()
action ()
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 {
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 :: forall a. IO a -> IO a
doNotLeakCommandLineArgumentsToExamples = forall a. [String] -> IO a -> IO a
withArgs []
withHiddenCursor :: Bool -> Handle -> IO a -> IO a
withHiddenCursor :: forall a. Bool -> Handle -> IO a -> IO a
withHiddenCursor Bool
useColor Handle
h
| Bool
useColor = 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 = forall a. a -> a
id
colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool)
colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool)
colorOutputSupported ColorMode
mode IO Bool
isTerminalDevice = do
Bool
github <- IO Bool
githubActions
Bool
buildkite <- String -> IO (Maybe String)
lookupEnv String
"BUILDKITE" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"true")
Bool
useColor <- case ColorMode
mode of
ColorMode
ColorAuto -> (Bool
github Bool -> Bool -> Bool
||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
colorTerminal
ColorMode
ColorNever -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ColorMode
ColorAlways -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
let reportProgress :: Bool
reportProgress = Bool -> Bool
not Bool
github Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
buildkite Bool -> Bool -> Bool
&& Bool
useColor
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
reportProgress, Bool
useColor)
where
githubActions :: IO Bool
githubActions :: IO Bool
githubActions = String -> IO (Maybe String)
lookupEnv String
"GITHUB_ACTIONS" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"true")
colorTerminal :: IO Bool
colorTerminal :: IO Bool
colorTerminal = Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
noColor) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Bool
isTerminalDevice
noColor :: IO Bool
noColor :: IO Bool
noColor = String -> IO (Maybe String)
lookupEnv String
"NO_COLOR" forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a
Nothing)
unicodeOutputSupported :: UnicodeMode -> Handle -> IO Bool
unicodeOutputSupported :: UnicodeMode -> Handle -> IO Bool
unicodeOutputSupported UnicodeMode
mode Handle
h = case UnicodeMode
mode of
UnicodeMode
UnicodeAuto -> (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"UTF-8") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
UnicodeMode
UnicodeNever -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
UnicodeMode
UnicodeAlways -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (FailureReport -> [Path]
failureReportPaths FailureReport
oldFailureReport)
data Summary = Summary {
Summary -> Int
summaryExamples :: Int
, Summary -> Int
summaryFailures :: Int
} deriving (Summary -> Summary -> Bool
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
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)
instance Semigroup Summary where
#endif
(Summary Int
x1 Int
x2)
#if MIN_VERSION_base(4,11,0)
<> :: Summary -> Summary -> Summary
<>
#else
`mappend`
#endif
(Summary Int
y1 Int
y2) = Int -> Int -> Summary
Summary (Int
x1 forall a. Num a => a -> a -> a
+ Int
y1) (Int
x2 forall a. Num a => a -> a -> a
+ Int
y2)
randomizeForest :: Integer -> [Tree c a] -> [Tree c a]
randomizeForest :: forall c a. Integer -> [Tree c a] -> [Tree c a]
randomizeForest Integer
seed [Tree c a]
t = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STRef s StdGen
ref <- forall a s. a -> ST s (STRef s a)
newSTRef (Int -> StdGen
mkStdGen forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seed)
forall s c a. STRef s StdGen -> [Tree c a] -> ST s [Tree c a]
shuffleForest STRef s StdGen
ref [Tree c a]
t
countSpecItems :: [Eval.Tree c a] -> Int
countSpecItems :: forall c a. [Tree c a] -> Int
countSpecItems = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> Sum a
Sum Int
1)