    -- |
    -- Module:      Test.Tasty.Ingredients.Rerun
    -- Copyright:   Oliver Charles (c) 2014, Andrew Lelechenko (c) 2019
    -- Licence:     BSD3
    --
    -- This ingredient
    -- for <https://hackage.haskell.org/package/tasty tasty> testing framework
    -- allows to filter a test tree depending
    -- on an outcome of the previous run.
    -- This may be useful in many scenarios,
    -- especially when a test suite grows large.
    --
    -- The behaviour is controlled by command-line options:
    --
    -- * @--rerun@ @ @
    --
    --     Rerun only tests, which failed during the last run.
    --     If the last run was successful, execute a full test
    --     suite afresh. A shortcut for @--rerun-update@
    --     @--rerun-filter failures,exceptions@
    --     @--rerun-all-on-success@.
    --
    -- * @--rerun-update@ @ @
    --
    --     Update the log file to reflect latest test outcomes.
    --
    -- * @--rerun-filter@ @CATEGORIES@
    --
    --     Read the log file and rerun only tests from a given
    --     comma-separated list of categories: @failures@,
    --     @exceptions@, @new@, @successful@. If this option is
    --     omitted or the log file is missing, rerun everything.
    --
    -- * @--rerun-all-on-success@ @ @
    --
    --     If according to the log file and @--rerun-filter@ there
    --     is nothing left to rerun, run all tests. This comes
    --     especially handy in @stack test --file-watch@ or
    --     @ghcid@ scenarios.
    --
    -- * @--rerun-log-file@ @FILE@
    --
    --     Location of the log file (default: @.tasty-rerun-log@).
    --
    -- To add it to your test suite just replace
    -- 'Tasty.defaultMain' with
    -- 'defaultMainWithRerun' or wrap arguments
    -- of 'Tasty.defaultMainWithIngredients'
    -- into 'rerunningTests'.

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE FlexibleContexts #-}

    module Test.Tasty.Ingredients.Rerun
      ( defaultMainWithRerun
      , rerunningTests
      ) where

    import Prelude (Enum, Bounded, minBound, maxBound, error, (+))

    import Control.Applicative (Const(..), (<$>), pure, (<$))
    import Control.Arrow ((>>>))
    import Control.Monad (when, return, fmap, mapM, (>>=))
    import Control.Monad.Trans.Class (lift)
    import Data.Bool (Bool (..), otherwise, not, (&&))
    import Data.Char (isSpace, toLower)
    import Data.Eq (Eq)
    import Data.Foldable (asum)
    import Data.Function ((.), ($), flip, const)
    import Data.Int (Int)
    import Data.List (intercalate, lookup, map, (++), reverse, dropWhile)
    import Data.List.Split (endBy)
    import Data.Maybe (fromMaybe, Maybe(..), maybe)
    import Data.Monoid (Any(..), Monoid(..))
    import Data.Ord (Ord)
    import Data.Proxy (Proxy(..))
    import Data.String (String)
    import Data.Typeable (Typeable)
    import System.IO (FilePath, IO, readFile, writeFile)
    import System.IO.Error (catchIOError, isDoesNotExistError, ioError)
    import Text.Read (Read, read)
    import Text.Show (Show, show)

    import qualified Control.Concurrent.STM as STM
    import qualified Control.Monad.State as State
    import qualified Data.Functor.Compose as Functor
    import qualified Data.IntMap as IntMap
    import qualified Data.Map.Strict as Map
    import qualified Data.Set as Set
    import qualified Options.Applicative as OptParse
    import qualified Test.Tasty.Options as Tasty
    import qualified Test.Tasty.Runners as Tasty

    --------------------------------------------------------------------------------
    newtype RerunLogFile = RerunLogFile FilePath
      deriving (Typeable)

    instance Tasty.IsOption RerunLogFile where
      optionName :: Tagged RerunLogFile TestName
    optionName = TestName -> Tagged RerunLogFile TestName
    forall a. a -> Tagged RerunLogFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "rerun-log-file"
      optionHelp :: Tagged RerunLogFile TestName
    optionHelp = TestName -> Tagged RerunLogFile TestName
    forall a. a -> Tagged RerunLogFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "Location of the log file (default: .tasty-rerun-log)"
      defaultValue :: RerunLogFile
    defaultValue = TestName -> RerunLogFile
    RerunLogFile TestName
    ".tasty-rerun-log"
      parseValue :: TestName -> Maybe RerunLogFile
    parseValue = RerunLogFile -> Maybe RerunLogFile
    forall a. a -> Maybe a
    Just (RerunLogFile -> Maybe RerunLogFile)
    -> (TestName -> RerunLogFile) -> TestName -> Maybe RerunLogFile
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestName -> RerunLogFile
    RerunLogFile
      optionCLParser :: Parser RerunLogFile
    optionCLParser = Mod OptionFields RerunLogFile -> Parser RerunLogFile
    forall v. IsOption v => Mod OptionFields v -> Parser v
    Tasty.mkOptionCLParser (TestName -> Mod OptionFields RerunLogFile
    forall (f :: * -> *) a. HasMetavar f => TestName -> Mod f a
    OptParse.metavar TestName
    "FILE")

    --------------------------------------------------------------------------------
    newtype UpdateLog = UpdateLog Bool
      deriving (Typeable)

    instance Tasty.IsOption UpdateLog where
      optionName :: Tagged UpdateLog TestName
    optionName = TestName -> Tagged UpdateLog TestName
    forall a. a -> Tagged UpdateLog a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "rerun-update"
      optionHelp :: Tagged UpdateLog TestName
    optionHelp = TestName -> Tagged UpdateLog TestName
    forall a. a -> Tagged UpdateLog a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "Update the log file to reflect latest test outcomes"
      defaultValue :: UpdateLog
    defaultValue = Bool -> UpdateLog
    UpdateLog Bool
    False
      parseValue :: TestName -> Maybe UpdateLog
    parseValue = (Bool -> UpdateLog) -> Maybe Bool -> Maybe UpdateLog
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> UpdateLog
    UpdateLog (Maybe Bool -> Maybe UpdateLog)
    -> (TestName -> Maybe Bool) -> TestName -> Maybe UpdateLog
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestName -> Maybe Bool
    Tasty.safeReadBool
      optionCLParser :: Parser UpdateLog
    optionCLParser = Mod FlagFields UpdateLog -> UpdateLog -> Parser UpdateLog
    forall v. IsOption v => Mod FlagFields v -> v -> Parser v
    Tasty.mkFlagCLParser Mod FlagFields UpdateLog
    forall a. Monoid a => a
    mempty (Bool -> UpdateLog
    UpdateLog Bool
    True)

    --------------------------------------------------------------------------------
    data Filter = Failures | Exceptions | New | Successful
      deriving (Filter -> Filter -> Bool
    (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Bool) -> Eq Filter
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Filter -> Filter -> Bool
    == :: Filter -> Filter -> Bool
    $c/= :: Filter -> Filter -> Bool
    /= :: Filter -> Filter -> Bool
    Eq, Eq Filter
    Eq Filter
    -> (Filter -> Filter -> Ordering)
    -> (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Bool)
    -> (Filter -> Filter -> Filter)
    -> (Filter -> Filter -> Filter)
    -> Ord Filter
    Filter -> Filter -> Bool
    Filter -> Filter -> Ordering
    Filter -> Filter -> Filter
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Filter -> Filter -> Ordering
    compare :: Filter -> Filter -> Ordering
    $c< :: Filter -> Filter -> Bool
    < :: Filter -> Filter -> Bool
    $c<= :: Filter -> Filter -> Bool
    <= :: Filter -> Filter -> Bool
    $c> :: Filter -> Filter -> Bool
    > :: Filter -> Filter -> Bool
    $c>= :: Filter -> Filter -> Bool
    >= :: Filter -> Filter -> Bool
    $cmax :: Filter -> Filter -> Filter
    max :: Filter -> Filter -> Filter
    $cmin :: Filter -> Filter -> Filter
    min :: Filter -> Filter -> Filter
    Ord, Int -> Filter
    Filter -> Int
    Filter -> [Filter]
    Filter -> Filter
    Filter -> Filter -> [Filter]
    Filter -> Filter -> Filter -> [Filter]
    (Filter -> Filter)
    -> (Filter -> Filter)
    -> (Int -> Filter)
    -> (Filter -> Int)
    -> (Filter -> [Filter])
    -> (Filter -> Filter -> [Filter])
    -> (Filter -> Filter -> [Filter])
    -> (Filter -> Filter -> Filter -> [Filter])
    -> Enum Filter
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: Filter -> Filter
    succ :: Filter -> Filter
    $cpred :: Filter -> Filter
    pred :: Filter -> Filter
    $ctoEnum :: Int -> Filter
    toEnum :: Int -> Filter
    $cfromEnum :: Filter -> Int
    fromEnum :: Filter -> Int
    $cenumFrom :: Filter -> [Filter]
    enumFrom :: Filter -> [Filter]
    $cenumFromThen :: Filter -> Filter -> [Filter]
    enumFromThen :: Filter -> Filter -> [Filter]
    $cenumFromTo :: Filter -> Filter -> [Filter]
    enumFromTo :: Filter -> Filter -> [Filter]
    $cenumFromThenTo :: Filter -> Filter -> Filter -> [Filter]
    enumFromThenTo :: Filter -> Filter -> Filter -> [Filter]
    Enum, Filter
    Filter -> Filter -> Bounded Filter
    forall a. a -> a -> Bounded a
    $cminBound :: Filter
    minBound :: Filter
    $cmaxBound :: Filter
    maxBound :: Filter
    Bounded, Int -> Filter -> ShowS
    [Filter] -> ShowS
    Filter -> TestName
    (Int -> Filter -> ShowS)
    -> (Filter -> TestName) -> ([Filter] -> ShowS) -> Show Filter
    forall a.
    (Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Filter -> ShowS
    showsPrec :: Int -> Filter -> ShowS
    $cshow :: Filter -> TestName
    show :: Filter -> TestName
    $cshowList :: [Filter] -> ShowS
    showList :: [Filter] -> ShowS
    Show)

    parseFilter :: String -> Maybe Filter
    parseFilter :: TestName -> Maybe Filter
    parseFilter TestName
    s = TestName -> [(TestName, Filter)] -> Maybe Filter
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup TestName
    s ((Filter -> (TestName, Filter)) -> [Filter] -> [(TestName, Filter)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Filter
    x -> ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (Filter -> TestName
    forall a. Show a => a -> TestName
    show Filter
    x), Filter
    x)) [Filter]
    everything)

    --------------------------------------------------------------------------------
    everything :: [Filter]
    everything :: [Filter]
    everything = [Filter
    forall a. Bounded a => a
    minBound..Filter
    forall a. Bounded a => a
    maxBound]

    --------------------------------------------------------------------------------
    newtype FilterOption = FilterOption (Set.Set Filter)
      deriving (Typeable)

    instance Tasty.IsOption FilterOption where
      optionName :: Tagged FilterOption TestName
    optionName = TestName -> Tagged FilterOption TestName
    forall a. a -> Tagged FilterOption a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "rerun-filter"
      optionHelp :: Tagged FilterOption TestName
    optionHelp = TestName -> Tagged FilterOption TestName
    forall a. a -> Tagged FilterOption a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        (TestName -> Tagged FilterOption TestName)
    -> TestName -> Tagged FilterOption TestName
    forall a b. (a -> b) -> a -> b
    $  TestName
    "Read the log file and rerun only tests from a given comma-separated list of categories: "
        TestName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (TestName -> [TestName] -> TestName
    forall a. [a] -> [[a]] -> [a]
    intercalate TestName
    ", " ((Filter -> TestName) -> [Filter] -> [TestName]
    forall a b. (a -> b) -> [a] -> [b]
    map Filter -> TestName
    forall a. Show a => a -> TestName
    show [Filter]
    everything))
        TestName -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ TestName
    ". If this option is omitted or the log file is missing, rerun everything."
      defaultValue :: FilterOption
    defaultValue = Set Filter -> FilterOption
    FilterOption ([Filter] -> Set Filter
    forall a. Ord a => [a] -> Set a
    Set.fromList [Filter]
    everything)
      parseValue :: TestName -> Maybe FilterOption
    parseValue =
        ([Filter] -> FilterOption) -> Maybe [Filter] -> Maybe FilterOption
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Set Filter -> FilterOption
    FilterOption (Set Filter -> FilterOption)
    -> ([Filter] -> Set Filter) -> [Filter] -> FilterOption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Filter] -> Set Filter
    forall a. Ord a => [a] -> Set a
    Set.fromList) (Maybe [Filter] -> Maybe FilterOption)
    -> (TestName -> Maybe [Filter]) -> TestName -> Maybe FilterOption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TestName -> Maybe Filter) -> [TestName] -> Maybe [Filter]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (TestName -> Maybe Filter
    parseFilter (TestName -> Maybe Filter) -> ShowS -> TestName -> Maybe Filter
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    trim) ([TestName] -> Maybe [Filter])
    -> (TestName -> [TestName]) -> TestName -> Maybe [Filter]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestName -> TestName -> [TestName]
    forall a. Eq a => [a] -> [a] -> [[a]]
    endBy TestName
    ","
        where trim :: ShowS
    trim = ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace
      optionCLParser :: Parser FilterOption
    optionCLParser = Mod OptionFields FilterOption -> Parser FilterOption
    forall v. IsOption v => Mod OptionFields v -> Parser v
    Tasty.mkOptionCLParser (TestName -> Mod OptionFields FilterOption
    forall (f :: * -> *) a. HasMetavar f => TestName -> Mod f a
    OptParse.metavar TestName
    "CATEGORIES")

    --------------------------------------------------------------------------------
    newtype AllOnSuccess = AllOnSuccess Bool
      deriving (Typeable)

    instance Tasty.IsOption AllOnSuccess where
      optionName :: Tagged AllOnSuccess TestName
    optionName = TestName -> Tagged AllOnSuccess TestName
    forall a. a -> Tagged AllOnSuccess a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "rerun-all-on-success"
      optionHelp :: Tagged AllOnSuccess TestName
    optionHelp = TestName -> Tagged AllOnSuccess TestName
    forall a. a -> Tagged AllOnSuccess a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "If according to the log file and --rerun-filter there is nothing left to rerun, run all tests. This comes especially handy in `stack test --file-watch` or `ghcid` scenarios."
      defaultValue :: AllOnSuccess
    defaultValue = Bool -> AllOnSuccess
    AllOnSuccess Bool
    False
      parseValue :: TestName -> Maybe AllOnSuccess
    parseValue = (Bool -> AllOnSuccess) -> Maybe Bool -> Maybe AllOnSuccess
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> AllOnSuccess
    AllOnSuccess (Maybe Bool -> Maybe AllOnSuccess)
    -> (TestName -> Maybe Bool) -> TestName -> Maybe AllOnSuccess
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestName -> Maybe Bool
    Tasty.safeReadBool
      optionCLParser :: Parser AllOnSuccess
    optionCLParser = Mod FlagFields AllOnSuccess -> AllOnSuccess -> Parser AllOnSuccess
    forall v. IsOption v => Mod FlagFields v -> v -> Parser v
    Tasty.mkFlagCLParser Mod FlagFields AllOnSuccess
    forall a. Monoid a => a
    mempty (Bool -> AllOnSuccess
    AllOnSuccess Bool
    True)

    --------------------------------------------------------------------------------
    newtype Rerun = Rerun { Rerun -> Bool
    unRerun :: Bool }
      deriving (Typeable)

    instance Tasty.IsOption Rerun where
      optionName :: Tagged Rerun TestName
    optionName = TestName -> Tagged Rerun TestName
    forall a. a -> Tagged Rerun a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "rerun"
      optionHelp :: Tagged Rerun TestName
    optionHelp = TestName -> Tagged Rerun TestName
    forall a. a -> Tagged Rerun a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TestName
    "Rerun only tests, which failed during the last run. If the last run was successful, execute a full test suite afresh. A shortcut for --rerun-update --rerun-filter failures,exceptions --rerun-all-on-success"
      defaultValue :: Rerun
    defaultValue = Bool -> Rerun
    Rerun Bool
    False
      parseValue :: TestName -> Maybe Rerun
    parseValue = (Bool -> Rerun) -> Maybe Bool -> Maybe Rerun
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> Rerun
    Rerun (Maybe Bool -> Maybe Rerun)
    -> (TestName -> Maybe Bool) -> TestName -> Maybe Rerun
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestName -> Maybe Bool
    Tasty.safeReadBool
      optionCLParser :: Parser Rerun
    optionCLParser = Mod FlagFields Rerun -> Rerun -> Parser Rerun
    forall v. IsOption v => Mod FlagFields v -> v -> Parser v
    Tasty.mkFlagCLParser Mod FlagFields Rerun
    forall a. Monoid a => a
    mempty (Bool -> Rerun
    Rerun Bool
    True)

    rerunMeaning :: (UpdateLog, AllOnSuccess, FilterOption)
    rerunMeaning :: (UpdateLog, AllOnSuccess, FilterOption)
    rerunMeaning = (Bool -> UpdateLog
    UpdateLog Bool
    True, Bool -> AllOnSuccess
    AllOnSuccess Bool
    True, Set Filter -> FilterOption
    FilterOption ([Filter] -> Set Filter
    forall a. Ord a => [a] -> Set a
    Set.fromList [Filter
    Failures, Filter
    Exceptions]))

    --------------------------------------------------------------------------------
    data TestResult = Completed Bool | ThrewException
      deriving (ReadPrec [TestResult]
    ReadPrec TestResult
    Int -> ReadS TestResult
    ReadS [TestResult]
    (Int -> ReadS TestResult)
    -> ReadS [TestResult]
    -> ReadPrec TestResult
    -> ReadPrec [TestResult]
    -> Read TestResult
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS TestResult
    readsPrec :: Int -> ReadS TestResult
    $creadList :: ReadS [TestResult]
    readList :: ReadS [TestResult]
    $creadPrec :: ReadPrec TestResult
    readPrec :: ReadPrec TestResult
    $creadListPrec :: ReadPrec [TestResult]
    readListPrec :: ReadPrec [TestResult]
    Read, Int -> TestResult -> ShowS
    [TestResult] -> ShowS
    TestResult -> TestName
    (Int -> TestResult -> ShowS)
    -> (TestResult -> TestName)
    -> ([TestResult] -> ShowS)
    -> Show TestResult
    forall a.
    (Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TestResult -> ShowS
    showsPrec :: Int -> TestResult -> ShowS
    $cshow :: TestResult -> TestName
    show :: TestResult -> TestName
    $cshowList :: [TestResult] -> ShowS
    showList :: [TestResult] -> ShowS
    Show)

    --------------------------------------------------------------------------------

    -- | Drop-in replacement for 'Tasty.defaultMain'.
    --
    -- > import Test.Tasty
    -- > import Test.Tasty.Ingredients.Rerun
    -- >
    -- > main :: IO ()
    -- > main = defaultMainWithRerun tests
    -- >
    -- > tests :: TestTree
    -- > tests = undefined
    defaultMainWithRerun :: Tasty.TestTree -> IO ()
    defaultMainWithRerun :: TestTree -> IO ()
    defaultMainWithRerun =
      [Ingredient] -> TestTree -> IO ()
    Tasty.defaultMainWithIngredients
        [ [Ingredient] -> Ingredient
    rerunningTests [ Ingredient
    Tasty.listingTests, Ingredient
    Tasty.consoleTestReporter ] ]

    -- | Ingredient transformer, to use with
    -- 'Tasty.defaultMainWithIngredients'.
    --
    -- > import Test.Tasty
    -- > import Test.Tasty.Runners
    -- > import Test.Tasty.Ingredients.Rerun
    -- >
    -- > main :: IO ()
    -- > main =
    -- >   defaultMainWithIngredients
    -- >     [ rerunningTests [ listingTests, consoleTestReporter ] ]
    -- >     tests
    -- >
    -- > tests :: TestTree
    -- > tests = undefined
    rerunningTests :: [Tasty.Ingredient] -> Tasty.Ingredient
    rerunningTests :: [Ingredient] -> Ingredient
    rerunningTests [Ingredient]
    ingredients =
      [OptionDescription]
    -> (OptionSet -> TestTree -> Maybe (IO Bool)) -> Ingredient
    Tasty.TestManager ([OptionDescription]
    rerunOptions [OptionDescription] -> [OptionDescription] -> [OptionDescription]
    forall a. [a] -> [a] -> [a]
    ++ [Ingredient] -> [OptionDescription]
    Tasty.ingredientsOptions [Ingredient]
    ingredients) ((OptionSet -> TestTree -> Maybe (IO Bool)) -> Ingredient)
    -> (OptionSet -> TestTree -> Maybe (IO Bool)) -> Ingredient
    forall a b. (a -> b) -> a -> b
    $
        \OptionSet
    options TestTree
    testTree -> IO Bool -> Maybe (IO Bool)
    forall a. a -> Maybe a
    Just (IO Bool -> Maybe (IO Bool)) -> IO Bool -> Maybe (IO Bool)
    forall a b. (a -> b) -> a -> b
    $ do
          let RerunLogFile TestName
    stateFile = OptionSet -> RerunLogFile
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options
              (UpdateLog Bool
    updateLog, AllOnSuccess Bool
    allOnSuccess, FilterOption Set Filter
    filter)
                | Rerun -> Bool
    unRerun (OptionSet -> Rerun
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options) = (UpdateLog, AllOnSuccess, FilterOption)
    rerunMeaning
                | Bool
    otherwise = (OptionSet -> UpdateLog
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options, OptionSet -> AllOnSuccess
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options, OptionSet -> FilterOption
    forall v. IsOption v => OptionSet -> v
    Tasty.lookupOption OptionSet
    options)

          let nonEmptyFold :: TreeFold Any
    nonEmptyFold = TreeFold Any
    forall b. Monoid b => TreeFold b
    Tasty.trivialFold { foldSingle :: forall t. IsTest t => OptionSet -> TestName -> t -> Any
    Tasty.foldSingle = \OptionSet
    _ TestName
    _ t
    _ -> Bool -> Any
    Any Bool
    True }
              nullTestTree :: TestTree -> Bool
    nullTestTree = Bool -> Bool
    not (Bool -> Bool) -> (TestTree -> Bool) -> TestTree -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Bool
    getAny (Any -> Bool) -> (TestTree -> Any) -> TestTree -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TreeFold Any -> OptionSet -> TestTree -> Any
    forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
    Tasty.foldTestTree TreeFold Any
    nonEmptyFold OptionSet
    options
              recoverFromEmpty :: TestTree -> TestTree
    recoverFromEmpty TestTree
    t = if Bool
    allOnSuccess Bool -> Bool -> Bool
    && TestTree -> Bool
    nullTestTree TestTree
    t then TestTree
    testTree else TestTree
    t

          TestTree
    filteredTestTree <- TestTree
    -> (Map [TestName] TestResult -> TestTree)
    -> Maybe (Map [TestName] TestResult)
    -> TestTree
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TestTree
    testTree (TestTree -> TestTree
    recoverFromEmpty (TestTree -> TestTree)
    -> (Map [TestName] TestResult -> TestTree)
    -> Map [TestName] TestResult
    -> TestTree
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestTree -> Set Filter -> Map [TestName] TestResult -> TestTree
    filterTestTree TestTree
    testTree Set Filter
    filter)
                               (Maybe (Map [TestName] TestResult) -> TestTree)
    -> IO (Maybe (Map [TestName] TestResult)) -> IO TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TestName -> IO (Maybe (Map [TestName] TestResult))
    tryLoadStateFrom TestName
    stateFile

          let tryAndRun :: Ingredient -> Maybe (IO Bool)
    tryAndRun (Tasty.TestReporter [OptionDescription]
    _ OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
    f) = do
                StatusMap -> IO (Time -> IO Bool)
    runner <- OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
    f OptionSet
    options TestTree
    filteredTestTree
                IO Bool -> Maybe (IO Bool)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO Bool -> Maybe (IO Bool)) -> IO Bool -> Maybe (IO Bool)
    forall a b. (a -> b) -> a -> b
    $ do
                  (StatusMap
    statusMap, Bool
    outcome) <-
                    OptionSet
    -> TestTree
    -> (StatusMap -> IO (Time -> IO (StatusMap, Bool)))
    -> IO (StatusMap, Bool)
    forall a.
    OptionSet -> TestTree -> (StatusMap -> IO (Time -> IO a)) -> IO a
    Tasty.launchTestTree OptionSet
    options TestTree
    filteredTestTree ((StatusMap -> IO (Time -> IO (StatusMap, Bool)))
     -> IO (StatusMap, Bool))
    -> (StatusMap -> IO (Time -> IO (StatusMap, Bool)))
    -> IO (StatusMap, Bool)
    forall a b. (a -> b) -> a -> b
    $ \StatusMap
    sMap ->
                      do Time -> IO Bool
    f' <- StatusMap -> IO (Time -> IO Bool)
    runner StatusMap
    sMap
                         (Time -> IO (StatusMap, Bool)) -> IO (Time -> IO (StatusMap, Bool))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bool -> (StatusMap, Bool)) -> IO Bool -> IO (StatusMap, Bool)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Bool
    a -> (StatusMap
    sMap, Bool
    a)) (IO Bool -> IO (StatusMap, Bool))
    -> (Time -> IO Bool) -> Time -> IO (StatusMap, Bool)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Time -> IO Bool
    f')

                  let getTestResults :: IO (Map [TestName] TestResult)
    getTestResults =
                        (Const (Map [TestName] TestResult) () -> Map [TestName] TestResult)
    -> IO (Const (Map [TestName] TestResult) ())
    -> IO (Map [TestName] TestResult)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Const (Map [TestName] TestResult) () -> Map [TestName] TestResult
    forall {k} a (b :: k). Const a b -> a
    getConst (IO (Const (Map [TestName] TestResult) ())
     -> IO (Map [TestName] TestResult))
    -> IO (Const (Map [TestName] TestResult) ())
    -> IO (Map [TestName] TestResult)
    forall a b. (a -> b) -> a -> b
    $
                        (StateT Int IO (Const (Map [TestName] TestResult) ())
     -> Int -> IO (Const (Map [TestName] TestResult) ()))
    -> Int
    -> StateT Int IO (Const (Map [TestName] TestResult) ())
    -> IO (Const (Map [TestName] TestResult) ())
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT Int IO (Const (Map [TestName] TestResult) ())
    -> Int -> IO (Const (Map [TestName] TestResult) ())
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    State.evalStateT Int
    0 (StateT Int IO (Const (Map [TestName] TestResult) ())
     -> IO (Const (Map [TestName] TestResult) ()))
    -> StateT Int IO (Const (Map [TestName] TestResult) ())
    -> IO (Const (Map [TestName] TestResult) ())
    forall a b. (a -> b) -> a -> b
    $
                        Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ()
    -> StateT Int IO (Const (Map [TestName] TestResult) ())
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    Functor.getCompose (Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ()
     -> StateT Int IO (Const (Map [TestName] TestResult) ()))
    -> Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ()
    -> StateT Int IO (Const (Map [TestName] TestResult) ())
    forall a b. (a -> b) -> a -> b
    $
                        Traversal
      (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    -> Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ()
    forall (f :: * -> *). Traversal f -> f ()
    Tasty.getTraversal (Traversal
       (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
     -> Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ())
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    -> Compose (StateT Int IO) (Const (Map [TestName] TestResult)) ()
    forall a b. (a -> b) -> a -> b
    $
                        TreeFold
      (Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult))))
    -> OptionSet
    -> TestTree
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
    Tasty.foldTestTree (StatusMap
    -> TreeFold
         (Traversal
            (Compose (StateT Int IO) (Const (Map [TestName] TestResult))))
    observeResults StatusMap
    statusMap)
                                            OptionSet
    options TestTree
    filteredTestTree

                  Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    updateLog (TestName -> IO (Map [TestName] TestResult) -> IO ()
    saveStateTo TestName
    stateFile IO (Map [TestName] TestResult)
    getTestResults)
                  Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    outcome

              tryAndRun (Tasty.TestManager [OptionDescription]
    _ OptionSet -> TestTree -> Maybe (IO Bool)
    f) =
                OptionSet -> TestTree -> Maybe (IO Bool)
    f OptionSet
    options TestTree
    filteredTestTree

          case [Maybe (IO Bool)] -> Maybe (IO Bool)
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum ((Ingredient -> Maybe (IO Bool))
    -> [Ingredient] -> [Maybe (IO Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map Ingredient -> Maybe (IO Bool)
    tryAndRun [Ingredient]
    ingredients) of
            -- No Ingredients chose to run the tests, we should really return
            -- Nothing, but we've already committed to run by the act of
            -- filtering the TestTree.
            Maybe (IO Bool)
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            -- Otherwise, an Ingredient did choose to run the tests, so we
            -- simply run the above constructed IO action.
            Just IO Bool
    e -> IO Bool
    e
      where
      rerunOptions :: [OptionDescription]
    rerunOptions = [ Proxy Rerun -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy Rerun
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy Rerun)
                     , Proxy UpdateLog -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy UpdateLog
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy UpdateLog)
                     , Proxy FilterOption -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy FilterOption
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy FilterOption)
                     , Proxy AllOnSuccess -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy AllOnSuccess
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy AllOnSuccess)
                     , Proxy RerunLogFile -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Tasty.Option (Proxy RerunLogFile
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy RerunLogFile)
                     ]

      ------------------------------------------------------------------------------
      filterTestTree :: Tasty.TestTree -> Set.Set Filter -> Map.Map [String] TestResult -> Tasty.TestTree
      filterTestTree :: TestTree -> Set Filter -> Map [TestName] TestResult -> TestTree
    filterTestTree TestTree
    testTree Set Filter
    filter Map [TestName] TestResult
    lastRecord =
        let go :: [TestName] -> TestTree -> TestTree
    go [TestName]
    prefix (Tasty.SingleTest TestName
    name t
    t) =
              let requiredFilter :: Filter
    requiredFilter = case [TestName] -> Map [TestName] TestResult -> Maybe TestResult
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup ([TestName]
    prefix [TestName] -> [TestName] -> [TestName]
    forall a. [a] -> [a] -> [a]
    ++ [TestName
    name]) Map [TestName] TestResult
    lastRecord of
                    Just (Completed Bool
    False) -> Filter
    Failures
                    Just TestResult
    ThrewException -> Filter
    Exceptions
                    Just (Completed Bool
    True) -> Filter
    Successful
                    Maybe TestResult
    Nothing -> Filter
    New
              in if (Filter
    requiredFilter Filter -> Set Filter -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Filter
    filter)
                   then TestName -> t -> TestTree
    forall t. IsTest t => TestName -> t -> TestTree
    Tasty.SingleTest TestName
    name t
    t
                   else TestName -> [TestTree] -> TestTree
    Tasty.TestGroup TestName
    "" []

            go [TestName]
    prefix (Tasty.TestGroup TestName
    name [TestTree]
    tests) =
              TestName -> [TestTree] -> TestTree
    Tasty.TestGroup TestName
    name ([TestName] -> TestTree -> TestTree
    go ([TestName]
    prefix [TestName] -> [TestName] -> [TestName]
    forall a. [a] -> [a] -> [a]
    ++ [TestName
    name]) (TestTree -> TestTree) -> [TestTree] -> [TestTree]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TestTree]
    tests)

            go [TestName]
    prefix (Tasty.PlusTestOptions OptionSet -> OptionSet
    f TestTree
    t) =
              (OptionSet -> OptionSet) -> TestTree -> TestTree
    Tasty.PlusTestOptions OptionSet -> OptionSet
    f ([TestName] -> TestTree -> TestTree
    go [TestName]
    prefix TestTree
    t)

            go [TestName]
    prefix (Tasty.WithResource ResourceSpec a
    rSpec IO a -> TestTree
    k) =
              ResourceSpec a -> (IO a -> TestTree) -> TestTree
    forall a. ResourceSpec a -> (IO a -> TestTree) -> TestTree
    Tasty.WithResource ResourceSpec a
    rSpec ([TestName] -> TestTree -> TestTree
    go [TestName]
    prefix (TestTree -> TestTree) -> (IO a -> TestTree) -> IO a -> TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a -> TestTree
    k)

            go [TestName]
    prefix (Tasty.AskOptions OptionSet -> TestTree
    k) =
              (OptionSet -> TestTree) -> TestTree
    Tasty.AskOptions ([TestName] -> TestTree -> TestTree
    go [TestName]
    prefix (TestTree -> TestTree)
    -> (OptionSet -> TestTree) -> OptionSet -> TestTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSet -> TestTree
    k)

            go [TestName]
    prefix (Tasty.After DependencyType
    a Expr
    b TestTree
    c) =
              DependencyType -> Expr -> TestTree -> TestTree
    Tasty.After DependencyType
    a Expr
    b ([TestName] -> TestTree -> TestTree
    go [TestName]
    prefix TestTree
    c)

        in [TestName] -> TestTree -> TestTree
    go [] TestTree
    testTree

      tryLoadStateFrom :: FilePath -> IO (Maybe (Map.Map [String] TestResult))
      tryLoadStateFrom :: TestName -> IO (Maybe (Map [TestName] TestResult))
    tryLoadStateFrom TestName
    filePath = do
        Maybe TestName
    fileContents <- (TestName -> Maybe TestName
    forall a. a -> Maybe a
    Just (TestName -> Maybe TestName) -> IO TestName -> IO (Maybe TestName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TestName -> IO TestName
    readFile TestName
    filePath)
                          IO (Maybe TestName)
    -> (IOError -> IO (Maybe TestName)) -> IO (Maybe TestName)
    forall a. IO a -> (IOError -> IO a) -> IO a
    `catchIOError` (\IOError
    e -> if IOError -> Bool
    isDoesNotExistError IOError
    e
                                                  then Maybe TestName -> IO (Maybe TestName)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe TestName
    forall a. Maybe a
    Nothing
                                                  else IOError -> IO (Maybe TestName)
    forall a. IOError -> IO a
    ioError IOError
    e)
        Maybe (Map [TestName] TestResult)
    -> IO (Maybe (Map [TestName] TestResult))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestName -> Map [TestName] TestResult
    forall a. Read a => TestName -> a
    read (TestName -> Map [TestName] TestResult)
    -> Maybe TestName -> Maybe (Map [TestName] TestResult)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe TestName
    fileContents)

      ------------------------------------------------------------------------------
      saveStateTo :: FilePath -> IO (Map.Map [String] TestResult) -> IO ()
      saveStateTo :: TestName -> IO (Map [TestName] TestResult) -> IO ()
    saveStateTo TestName
    filePath IO (Map [TestName] TestResult)
    getTestResults =
        IO (Map [TestName] TestResult)
    getTestResults IO (Map [TestName] TestResult)
    -> (Map [TestName] TestResult -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Map [TestName] TestResult -> TestName
    forall a. Show a => a -> TestName
    show (Map [TestName] TestResult -> TestName)
    -> (TestName -> IO ()) -> Map [TestName] TestResult -> IO ()
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> TestName -> TestName -> IO ()
    writeFile TestName
    filePath)

      ------------------------------------------------------------------------------
      observeResults
        :: IntMap.IntMap (STM.TVar Tasty.Status)
        -> Tasty.TreeFold (Tasty.Traversal (Functor.Compose (State.StateT Int IO) (Const (Map.Map [String] TestResult))))
      observeResults :: StatusMap
    -> TreeFold
         (Traversal
            (Compose (StateT Int IO) (Const (Map [TestName] TestResult))))
    observeResults StatusMap
    statusMap =
        let foldSingle :: p
    -> a
    -> p
    -> Traversal (Compose (t IO) (Const (Map [a] TestResult)))
    foldSingle p
    _ a
    name p
    _ = Compose (t IO) (Const (Map [a] TestResult)) ()
    -> Traversal (Compose (t IO) (Const (Map [a] TestResult)))
    forall (f :: * -> *). f () -> Traversal f
    Tasty.Traversal (Compose (t IO) (Const (Map [a] TestResult)) ()
     -> Traversal (Compose (t IO) (Const (Map [a] TestResult))))
    -> Compose (t IO) (Const (Map [a] TestResult)) ()
    -> Traversal (Compose (t IO) (Const (Map [a] TestResult)))
    forall a b. (a -> b) -> a -> b
    $ t IO (Const (Map [a] TestResult) ())
    -> Compose (t IO) (Const (Map [a] TestResult)) ()
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Functor.Compose (t IO (Const (Map [a] TestResult) ())
     -> Compose (t IO) (Const (Map [a] TestResult)) ())
    -> t IO (Const (Map [a] TestResult) ())
    -> Compose (t IO) (Const (Map [a] TestResult)) ()
    forall a b. (a -> b) -> a -> b
    $ do
              Int
    i <- t IO Int
    forall s (m :: * -> *). MonadState s m => m s
    State.get

              TestResult
    status <- IO TestResult -> t IO TestResult
    forall (m :: * -> *) a. Monad m => m a -> t m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO TestResult -> t IO TestResult)
    -> IO TestResult -> t IO TestResult
    forall a b. (a -> b) -> a -> b
    $ STM TestResult -> IO TestResult
    forall a. STM a -> IO a
    STM.atomically (STM TestResult -> IO TestResult)
    -> STM TestResult -> IO TestResult
    forall a b. (a -> b) -> a -> b
    $ do
                Status
    status <- Int -> STM Status
    lookupStatus Int
    i
                case Status
    status of
                  Tasty.Done Result
    result -> TestResult -> STM TestResult
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestResult -> STM TestResult) -> TestResult -> STM TestResult
    forall a b. (a -> b) -> a -> b
    $
                    case Result -> Outcome
    Tasty.resultOutcome Result
    result of
                      Tasty.Failure (Tasty.TestThrewException SomeException
    _) -> TestResult
    ThrewException
                      Outcome
    _ -> Bool -> TestResult
    Completed (Result -> Bool
    Tasty.resultSuccessful Result
    result)

                  Status
    _ -> STM TestResult
    forall a. STM a
    STM.retry

              Map [a] TestResult -> Const (Map [a] TestResult) ()
    forall {k} a (b :: k). a -> Const a b
    Const ([a] -> TestResult -> Map [a] TestResult
    forall k a. k -> a -> Map k a
    Map.singleton [a
    name] TestResult
    status) Const (Map [a] TestResult) ()
    -> t IO () -> t IO (Const (Map [a] TestResult) ())
    forall a b. a -> t IO b -> t IO a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (Int -> Int) -> t IO ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    State.modify (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

            foldGroup :: a
    -> Traversal (Compose f (Const (Map [a] a)))
    -> Traversal (Compose f (Const (Map [a] a)))
    foldGroup a
    name Traversal (Compose f (Const (Map [a] a)))
    children = Compose f (Const (Map [a] a)) ()
    -> Traversal (Compose f (Const (Map [a] a)))
    forall (f :: * -> *). f () -> Traversal f
    Tasty.Traversal (Compose f (Const (Map [a] a)) ()
     -> Traversal (Compose f (Const (Map [a] a))))
    -> Compose f (Const (Map [a] a)) ()
    -> Traversal (Compose f (Const (Map [a] a)))
    forall a b. (a -> b) -> a -> b
    $ f (Const (Map [a] a) ()) -> Compose f (Const (Map [a] a)) ()
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Functor.Compose (f (Const (Map [a] a) ()) -> Compose f (Const (Map [a] a)) ())
    -> f (Const (Map [a] a) ()) -> Compose f (Const (Map [a] a)) ()
    forall a b. (a -> b) -> a -> b
    $ do
              Const Map [a] a
    soFar <- Compose f (Const (Map [a] a)) () -> f (Const (Map [a] a) ())
    forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
    Compose f g a -> f (g a)
    Functor.getCompose (Compose f (Const (Map [a] a)) () -> f (Const (Map [a] a) ()))
    -> Compose f (Const (Map [a] a)) () -> f (Const (Map [a] a) ())
    forall a b. (a -> b) -> a -> b
    $ Traversal (Compose f (Const (Map [a] a)))
    -> Compose f (Const (Map [a] a)) ()
    forall (f :: * -> *). Traversal f -> f ()
    Tasty.getTraversal Traversal (Compose f (Const (Map [a] a)))
    children
              Const (Map [a] a) () -> f (Const (Map [a] a) ())
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Const (Map [a] a) () -> f (Const (Map [a] a) ()))
    -> Const (Map [a] a) () -> f (Const (Map [a] a) ())
    forall a b. (a -> b) -> a -> b
    $ Map [a] a -> Const (Map [a] a) ()
    forall {k} a (b :: k). a -> Const a b
    Const (([a] -> [a]) -> Map [a] a -> Map [a] a
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    Map.mapKeys (a
    name a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) Map [a] a
    soFar)

        in TreeFold
      (Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult))))
    forall b. Monoid b => TreeFold b
    Tasty.trivialFold
          { foldSingle :: forall t.
    IsTest t =>
    OptionSet
    -> TestName
    -> t
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    Tasty.foldSingle = OptionSet
    -> TestName
    -> t
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    forall t.
    IsTest t =>
    OptionSet
    -> TestName
    -> t
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    forall {t :: (* -> *) -> * -> *} {p} {a} {p}.
    (MonadState Int (t IO), MonadTrans t) =>
    p
    -> a
    -> p
    -> Traversal (Compose (t IO) (Const (Map [a] TestResult)))
    foldSingle
    #if MIN_VERSION_tasty(1,5,0)
          , Tasty.foldGroup = const (\name -> foldGroup name . mconcat)
    #elif MIN_VERSION_tasty(1,4,0)
          , foldGroup :: OptionSet
    -> TestName
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    Tasty.foldGroup = (TestName
     -> Traversal
          (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
     -> Traversal
          (Compose (StateT Int IO) (Const (Map [TestName] TestResult))))
    -> OptionSet
    -> TestName
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    forall a b. a -> b -> a
    const TestName
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    -> Traversal
         (Compose (StateT Int IO) (Const (Map [TestName] TestResult)))
    forall {f :: * -> *} {a} {a}.
    (Monad f, Ord a) =>
    a
    -> Traversal (Compose f (Const (Map [a] a)))
    -> Traversal (Compose f (Const (Map [a] a)))
    foldGroup
    #else
          , Tasty.foldGroup = foldGroup
    #endif
          }

        where
        lookupStatus :: Int -> STM Status
    lookupStatus Int
    i = TVar Status -> STM Status
    forall a. TVar a -> STM a
    STM.readTVar (TVar Status -> STM Status) -> TVar Status -> STM Status
    forall a b. (a -> b) -> a -> b
    $
          TVar Status -> Maybe (TVar Status) -> TVar Status
    forall a. a -> Maybe a -> a
    fromMaybe (TestName -> TVar Status
    forall a. HasCallStack => TestName -> a
    error TestName
    "Attempted to lookup test by index outside bounds")
                    (Int -> StatusMap -> Maybe (TVar Status)
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    i StatusMap
    statusMap)