    -- |
    -- Module      : Foundation.Check.Main
    -- License     : BSD-style
    -- Maintainer  : Foundation maintainers
    --
    -- An application to check that integrate with the .cabal test-suite
    --
    {-# LANGUAGE ExistentialQuantification  #-}
    {-# LANGUAGE Rank2Types                 #-}
    {-# LANGUAGE GADTs                      #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    module Foundation.Check.Main
        ( defaultMain
        ) where

    import           Basement.Imports
    import           Basement.IntegralConv
    import           Basement.Cast (cast)
    import           Basement.Bounded
    import           Basement.Types.OffsetSize
    import qualified Basement.Terminal.ANSI as ANSI
    import qualified Basement.Terminal as Terminal
    import           Foundation.Collection
    import           Foundation.Numerical
    import           Foundation.IO.Terminal
    import           Foundation.Check (iterateProperty)
    import           Foundation.Check.Gen
    import           Foundation.Check.Property
    import           Foundation.Check.Config
    import           Foundation.Check.Types
    import           Foundation.List.DList
    import           Foundation.Random
    import           Foundation.Monad
    import           Foundation.Monad.State
    import           Data.Maybe (catMaybes)

    nbFail :: TestResult -> HasFailures
    nbFail :: TestResult -> CountOf TestResult
    nbFail (PropertyResult String
    _ CountOf TestResult
    _ (PropertyFailed String
    _)) = CountOf TestResult
    1
    nbFail (PropertyResult String
    _ CountOf TestResult
    _ PropertyResult
    PropertySuccess)    = CountOf TestResult
    0
    nbFail (GroupResult    String
    _ CountOf TestResult
    t CountOf TestResult
    _ [TestResult]
    _)                = CountOf TestResult
    t

    nbTests :: TestResult -> CountOf TestResult
    nbTests :: TestResult -> CountOf TestResult
    nbTests (PropertyResult String
    _ CountOf TestResult
    t PropertyResult
    _) = CountOf TestResult
    t
    nbTests (GroupResult String
    _ CountOf TestResult
    _ CountOf TestResult
    t [TestResult]
    _)  = CountOf TestResult
    t

    data TestState = TestState
        { TestState -> Config
    config      :: !Config
        , TestState -> Word64
    getSeed     :: !Seed
        , TestState -> CountOf Char
    indent      :: !(CountOf Char)
        , TestState -> Word
    testPassed  :: !Word
        , TestState -> Word
    testFailed  :: !Word
        , TestState -> DList String
    testPath    :: !(DList String)
        }

    newState :: Config -> Seed -> TestState
    newState :: Config -> Word64 -> TestState
    newState Config
    cfg Word64
    initSeed = TestState
        { testPath :: DList String
    testPath     = DList String
    forall a. Monoid a => a
    mempty
        , testPassed :: Word
    testPassed   = Word
    0
        , testFailed :: Word
    testFailed   = Word
    0
        , indent :: CountOf Char
    indent       = CountOf Char
    0
        , getSeed :: Word64
    getSeed      = Word64
    initSeed
        , config :: Config
    config       = Config
    cfg
        }

    filterTestMatching :: Config -> Test -> Maybe Test
    filterTestMatching :: Config -> Test -> Maybe Test
    filterTestMatching Config
    cfg Test
    testRoot
        | [String] -> Bool
    forall c. Collection c => c -> Bool
    null (Config -> [String]
    testNameMatch Config
    cfg) = Test -> Maybe Test
    forall a. a -> Maybe a
    Just Test
    testRoot
        | Bool
    otherwise                = [String] -> Test -> Maybe Test
    testFilter [] Test
    testRoot
      where
        match :: [String] -> String -> Bool
    match [String]
    acc String
    s = [Bool] -> Bool
    forall col. (Collection col, Element col ~ Bool) => col -> Bool
    or ((String -> String -> Bool) -> String -> String -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> String -> Bool
    forall c. (Sequential c, Eq (Element c)) => c -> c -> Bool
    isInfixOf String
    currentTestName (String -> Bool) -> [String] -> [Bool]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Config -> [String]
    testNameMatch Config
    cfg)
          where currentTestName :: String
    currentTestName = [String] -> String
    fqTestName (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    acc)

        testFilter :: [String] -> Test -> Maybe Test
    testFilter [String]
    acc Test
    x =
            case Test
    x of
                Group String
    s [Test]
    l    ->
                    let filtered :: [Test]
    filtered = [Maybe Test] -> [Test]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Test] -> [Test]) -> [Maybe Test] -> [Test]
    forall a b. (a -> b) -> a -> b
    $ (Test -> Maybe Test) -> [Test] -> [Maybe Test]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([String] -> Test -> Maybe Test
    testFilter (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    acc)) [Test]
    l
                     in if [Test] -> Bool
    forall c. Collection c => c -> Bool
    null [Test]
    filtered then Maybe Test
    forall a. Maybe a
    Nothing else Test -> Maybe Test
    forall a. a -> Maybe a
    Just (String -> [Test] -> Test
    Group String
    s [Test]
    filtered)
                CheckPlan String
    s Check ()
    _
                    | [String] -> String -> Bool
    match [String]
    acc String
    s -> Test -> Maybe Test
    forall a. a -> Maybe a
    Just Test
    x
                    | Bool
    otherwise   -> Maybe Test
    forall a. Maybe a
    Nothing
                Unit String
    s IO ()
    _
                    | [String] -> String -> Bool
    match [String]
    acc String
    s -> Test -> Maybe Test
    forall a. a -> Maybe a
    Just Test
    x
                    | Bool
    otherwise   -> Maybe Test
    forall a. Maybe a
    Nothing
                Property String
    s prop
    _
                    | [String] -> String -> Bool
    match [String]
    acc String
    s -> Test -> Maybe Test
    forall a. a -> Maybe a
    Just Test
    x
                    | Bool
    otherwise   -> Maybe Test
    forall a. Maybe a
    Nothing

    -- | Run tests
    defaultMain :: Test -> IO ()
    defaultMain :: Test -> IO ()
    defaultMain Test
    allTestRoot = do
        IO ()
    Terminal.initialize

        -- parse arguments
        ecfg <- ([String] -> Config -> Either String Config)
    -> Config -> [String] -> Either String Config
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [String] -> Config -> Either String Config
    parseArgs Config
    defaultConfig ([String] -> Either String Config)
    -> IO [String] -> IO (Either String Config)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [String]
    getArgs
        cfg  <- case ecfg of
                Left String
    e  -> do
                    String -> IO ()
    putStrLn String
    e
                    (String -> IO ()) -> [String] -> IO ()
    forall (col :: * -> *) (m :: * -> *) a b.
    (Mappable col, Applicative m, Monad m) =>
    (a -> m b) -> col a -> m ()
    mapM_ String -> IO ()
    putStrLn [String]
    configHelp
                    IO Config
    forall a. IO a
    exitFailure
                Right Config
    c -> Config -> IO Config
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Config
    c

        -- use the user defined seed or generate a new seed
        seed <- maybe getRandomWord64 pure $ udfSeed cfg

        let testState = Config -> Word64 -> TestState
    newState Config
    cfg Word64
    seed

        when (helpRequested cfg) (mapM_ putStrLn configHelp >> exitSuccess)
        when (listTests cfg) (printTestName >> exitSuccess)

        putStrLn $ "\nSeed: " <> show seed <> "\n"

        case filterTestMatching cfg allTestRoot of
            Maybe Test
    Nothing -> String -> IO ()
    putStrLn String
    "no tests to run" IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    forall a. IO a
    exitSuccess
            Just Test
    t  -> do
                (_, cfg') <- StateT TestState IO TestResult
    -> TestState -> IO (TestResult, TestState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (CheckMain TestResult -> StateT TestState IO TestResult
    forall a. CheckMain a -> StateT TestState IO a
    runCheckMain (CheckMain TestResult -> StateT TestState IO TestResult)
    -> CheckMain TestResult -> StateT TestState IO TestResult
    forall a b. (a -> b) -> a -> b
    $ Test -> CheckMain TestResult
    test Test
    t) TestState
    testState
                summary cfg'

      where
        -- display a summary of the result and use the right exit code
        summary :: TestState -> IO b
    summary TestState
    cfg
            | Word
    kos Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word
    0 = do
                String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    red String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "Failed " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Word -> String
    forall a. Show a => a -> String
    show Word
    kos String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " out of " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Word -> String
    forall a. Show a => a -> String
    show Word
    tot String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
                IO b
    forall a. IO a
    exitFailure
            | Bool
    otherwise = do
                String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    green String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "Succeed " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Word -> String
    forall a. Show a => a -> String
    show Word
    oks String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " test(s)" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
                IO b
    forall a. IO a
    exitSuccess
          where
            oks :: Word
    oks = TestState -> Word
    testPassed TestState
    cfg
            kos :: Word
    kos = TestState -> Word
    testFailed TestState
    cfg
            tot :: Word
    tot = Word
    oks Word -> Word -> Word
    forall a. Additive a => a -> a -> a
    + Word
    kos

        -- print all the tests recursively
        printTestName :: IO ()
    printTestName = ([String] -> IO ()) -> [[String]] -> IO ()
    forall (col :: * -> *) (m :: * -> *) a b.
    (Mappable col, Applicative m, Monad m) =>
    (a -> m b) -> col a -> m ()
    mapM_ (\[String]
    tst -> String -> IO ()
    putStrLn ([String] -> String
    fqTestName [String]
    tst)) ([[String]] -> IO ()) -> [[String]] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(Test, [String])] -> [Test] -> [String] -> Test -> [[String]]
    testCases [] [] [] Test
    allTestRoot
          where
            testCases :: [(Test, [String])] -> [Test] -> [String] -> Test -> [[String]]
    testCases [(Test, [String])]
    acc [Test]
    xs [String]
    pre Test
    x =
                case Test
    x of
                    Group String
    s [Test]
    l     -> [(Test, [String])] -> [String] -> [Test] -> [[String]]
    tToList ((Test -> (Test, [String])) -> [Test] -> [(Test, [String])]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Test
    z -> (Test
    z, [String]
    pre)) [Test]
    xs [(Test, [String])] -> [(Test, [String])] -> [(Test, [String])]
    forall a. Semigroup a => a -> a -> a
    <> [(Test, [String])]
    acc) (String
    sString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    pre) [Test]
    l
                    CheckPlan String
    s Check ()
    _ -> (String
    s String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pre) [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [(Test, [String])] -> [String] -> [Test] -> [[String]]
    tToList [(Test, [String])]
    acc [String]
    pre [Test]
    xs
                    Unit String
    s IO ()
    _      -> (String
    s String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pre) [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [(Test, [String])] -> [String] -> [Test] -> [[String]]
    tToList [(Test, [String])]
    acc [String]
    pre [Test]
    xs
                    Property String
    s prop
    _  -> (String
    s String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    pre) [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    : [(Test, [String])] -> [String] -> [Test] -> [[String]]
    tToList [(Test, [String])]
    acc [String]
    pre [Test]
    xs

            tToList :: [(Test, [String])] -> [String] -> [Test] -> [[String]]
    tToList []           [String]
    _   []              = []
            tToList ((Test
    a,[String]
    pre):[(Test, [String])]
    as) [String]
    _   []              = [(Test, [String])] -> [Test] -> [String] -> Test -> [[String]]
    testCases [(Test, [String])]
    as [] [String]
    pre Test
    a
            tToList [(Test, [String])]
    acc          [String]
    pre (Test
    x:[Test]
    xs)          = [(Test, [String])] -> [Test] -> [String] -> Test -> [[String]]
    testCases [(Test, [String])]
    acc [Test]
    xs [String]
    pre Test
    x

    -- | internal check monad for facilitating the tests traversal
    newtype CheckMain a = CheckMain { forall a. CheckMain a -> StateT TestState IO a
    runCheckMain :: StateT TestState IO a }
      deriving ((forall a b. (a -> b) -> CheckMain a -> CheckMain b)
    -> (forall a b. a -> CheckMain b -> CheckMain a)
    -> Functor CheckMain
    forall a b. a -> CheckMain b -> CheckMain a
    forall a b. (a -> b) -> CheckMain a -> CheckMain b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> CheckMain a -> CheckMain b
    fmap :: forall a b. (a -> b) -> CheckMain a -> CheckMain b
    $c<$ :: forall a b. a -> CheckMain b -> CheckMain a
    <$ :: forall a b. a -> CheckMain b -> CheckMain a
    Functor, Functor CheckMain
    Functor CheckMain =>
    (forall a. a -> CheckMain a)
    -> (forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b)
    -> (forall a b c.
        (a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c)
    -> (forall a b. CheckMain a -> CheckMain b -> CheckMain b)
    -> (forall a b. CheckMain a -> CheckMain b -> CheckMain a)
    -> Applicative CheckMain
    forall a. a -> CheckMain a
    forall a b. CheckMain a -> CheckMain b -> CheckMain a
    forall a b. CheckMain a -> CheckMain b -> CheckMain b
    forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
    forall a b c.
    (a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> CheckMain a
    pure :: forall a. a -> CheckMain a
    $c<*> :: forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
    <*> :: forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
    $cliftA2 :: forall a b c.
    (a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
    liftA2 :: forall a b c.
    (a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
    $c*> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
    *> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
    $c<* :: forall a b. CheckMain a -> CheckMain b -> CheckMain a
    <* :: forall a b. CheckMain a -> CheckMain b -> CheckMain a
    Applicative, Applicative CheckMain
    Applicative CheckMain =>
    (forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b)
    -> (forall a b. CheckMain a -> CheckMain b -> CheckMain b)
    -> (forall a. a -> CheckMain a)
    -> Monad CheckMain
    forall a. a -> CheckMain a
    forall a b. CheckMain a -> CheckMain b -> CheckMain b
    forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
    >>= :: forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
    $c>> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
    >> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
    $creturn :: forall a. a -> CheckMain a
    return :: forall a. a -> CheckMain a
    Monad, Monad CheckMain
    Monad CheckMain =>
    (forall a. IO a -> CheckMain a) -> MonadIO CheckMain
    forall a. IO a -> CheckMain a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> CheckMain a
    liftIO :: forall a. IO a -> CheckMain a
    MonadIO)

    instance MonadState CheckMain where
        type State CheckMain = TestState
        withState :: forall a. (State CheckMain -> (a, State CheckMain)) -> CheckMain a
    withState = StateT TestState IO a -> CheckMain a
    forall a. StateT TestState IO a -> CheckMain a
    CheckMain (StateT TestState IO a -> CheckMain a)
    -> ((TestState -> (a, TestState)) -> StateT TestState IO a)
    -> (TestState -> (a, TestState))
    -> CheckMain a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (State (StateT TestState IO) -> (a, State (StateT TestState IO)))
    -> StateT TestState IO a
    (TestState -> (a, TestState)) -> StateT TestState IO a
    forall a.
    (State (StateT TestState IO) -> (a, State (StateT TestState IO)))
    -> StateT TestState IO a
    forall (m :: * -> *) a.
    MonadState m =>
    (State m -> (a, State m)) -> m a
    withState

    onDisplayOption :: DisplayOption -> CheckMain () -> CheckMain ()
    onDisplayOption :: DisplayOption -> CheckMain () -> CheckMain ()
    onDisplayOption DisplayOption
    opt CheckMain ()
    chk = do
        on <- DisplayOption -> DisplayOption -> Bool
    forall a. Ord a => a -> a -> Bool
    (<=) DisplayOption
    opt (DisplayOption -> Bool)
    -> (TestState -> DisplayOption) -> TestState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Config -> DisplayOption
    displayOptions (Config -> DisplayOption)
    -> (TestState -> Config) -> TestState -> DisplayOption
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . TestState -> Config
    config (TestState -> Bool) -> CheckMain TestState -> CheckMain Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        if on then chk else return ()

    whenErrorOnly :: CheckMain () -> CheckMain ()
    whenErrorOnly :: CheckMain () -> CheckMain ()
    whenErrorOnly = DisplayOption -> CheckMain () -> CheckMain ()
    onDisplayOption DisplayOption
    DisplayTerminalErrorOnly

    whenGroupOnly :: CheckMain () -> CheckMain ()
    whenGroupOnly :: CheckMain () -> CheckMain ()
    whenGroupOnly = DisplayOption -> CheckMain () -> CheckMain ()
    onDisplayOption DisplayOption
    DisplayGroupOnly

    whenVerbose :: CheckMain () -> CheckMain ()
    whenVerbose :: CheckMain () -> CheckMain ()
    whenVerbose = DisplayOption -> CheckMain () -> CheckMain ()
    onDisplayOption DisplayOption
    DisplayTerminalVerbose

    passed :: CheckMain ()
    passed :: CheckMain ()
    passed = (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a. (State CheckMain -> (a, State CheckMain)) -> CheckMain a
    forall (m :: * -> *) a.
    MonadState m =>
    (State m -> (a, State m)) -> m a
    withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
    -> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ \State CheckMain
    s -> ((), State CheckMain
    s { testPassed = testPassed s + 1 })

    failed :: CheckMain ()
    failed :: CheckMain ()
    failed = (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a. (State CheckMain -> (a, State CheckMain)) -> CheckMain a
    forall (m :: * -> *) a.
    MonadState m =>
    (State m -> (a, State m)) -> m a
    withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
    -> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ \State CheckMain
    s -> ((), State CheckMain
    s { testFailed = testFailed s + 1 })

    test :: Test -> CheckMain TestResult
    test :: Test -> CheckMain TestResult
    test (Group String
    s [Test]
    l) = String -> [Test] -> CheckMain TestResult
    pushGroup String
    s [Test]
    l
    test (Unit String
    _ IO ()
    _) = CheckMain TestResult
    forall a. HasCallStack => a
    undefined
    test (CheckPlan String
    name Check ()
    plan) = do
        String -> Check () -> CheckMain TestResult
    testCheckPlan String
    name Check ()
    plan
    test (Property String
    name prop
    prop) = do
        r <- String -> Property -> CheckMain TestResult
    testProperty String
    name (prop -> Property
    forall p. IsProperty p => p -> Property
    property prop
    prop)
        case r of
            (PropertyResult String
    _ CountOf TestResult
    nb PropertyResult
    PropertySuccess)    -> CheckMain () -> CheckMain ()
    whenVerbose (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ String -> CountOf TestResult -> CheckMain ()
    displayPropertySucceed String
    name CountOf TestResult
    nb
            (PropertyResult String
    _ CountOf TestResult
    nb (PropertyFailed String
    w)) -> CheckMain () -> CheckMain ()
    whenErrorOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ String -> CountOf TestResult -> String -> CheckMain ()
    displayPropertyFailed String
    name CountOf TestResult
    nb String
    w
            GroupResult {} -> String -> CheckMain ()
    forall a. HasCallStack => String -> a
    error String
    "internal error: should not happen"
        return r

    displayCurrent :: String -> CheckMain ()
    displayCurrent :: String -> CheckMain ()
    displayCurrent String
    name = do
        i <- TestState -> CountOf Char
    indent (TestState -> CountOf Char)
    -> CheckMain TestState -> CheckMain (CountOf Char)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        liftIO $ putStrLn $ replicate i ' ' <> name

    displayPropertySucceed :: String -> CountOf TestResult -> CheckMain ()
    displayPropertySucceed :: String -> CountOf TestResult -> CheckMain ()
    displayPropertySucceed String
    name (CountOf Int
    nb) = do
        i <- TestState -> CountOf Char
    indent (TestState -> CountOf Char)
    -> CheckMain TestState -> CheckMain (CountOf Char)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        liftIO $ putStrLn $ mconcat
            [ replicate i ' '
            , successString, name
            , " ("
            , show nb
            , if nb == 1 then " test)" else " tests)"
            ]

    unicodeEnabled :: Bool
    unicodeEnabled :: Bool
    unicodeEnabled = Bool
    True

    successString :: String
    successString :: String
    successString
        | Bool
    unicodeEnabled = String
    green String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " ✓ " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
        | Bool
    otherwise      = String
    green String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "[SUCCESS] " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
    {-# NOINLINE successString #-}

    failureString :: String
    failureString :: String
    failureString
        | Bool
    unicodeEnabled = String
    red String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " ✗ " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
        | Bool
    otherwise      = String
    red String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "[ ERROR ] " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reset
    {-# NOINLINE failureString #-}

    reset, green, red :: ANSI.Escape
    reset :: String
    reset = String
    ANSI.sgrReset
    green :: String
    green = ColorComponent -> Bool -> String
    ANSI.sgrForeground (Word64 -> ColorComponent
    forall (n :: Nat).
    (KnownNat n, NatWithinBound Word64 n) =>
    Word64 -> Zn64 n
    zn64 Word64
    2) Bool
    True
    red :: String
    red = ColorComponent -> Bool -> String
    ANSI.sgrForeground (Word64 -> ColorComponent
    forall (n :: Nat).
    (KnownNat n, NatWithinBound Word64 n) =>
    Word64 -> Zn64 n
    zn64 Word64
    1) Bool
    True

    displayPropertyFailed :: String -> CountOf TestResult -> String -> CheckMain ()
    displayPropertyFailed :: String -> CountOf TestResult -> String -> CheckMain ()
    displayPropertyFailed String
    name (CountOf Int
    nb) String
    w = do
        seed <- TestState -> Word64
    getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        i <- indent <$> get
        liftIO $ do
            putStrLn $ mconcat
              [ replicate i ' '
              , failureString, name
              , " failed after "
              , show nb
              , if nb == 1 then " test" else " tests:"
              ]
            putStrLn $ replicate i ' ' <> "   use param: --seed " <> show seed
            putStrLn w

    pushGroup :: String -> [Test] -> CheckMain TestResult
    pushGroup :: String -> [Test] -> CheckMain TestResult
    pushGroup String
    name [Test]
    list = do
        CheckMain () -> CheckMain ()
    whenGroupOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ if [Test] -> Bool
    groupHasSubGroup [Test]
    list then String -> CheckMain ()
    displayCurrent String
    name else () -> CheckMain ()
    forall a. a -> CheckMain a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a. (State CheckMain -> (a, State CheckMain)) -> CheckMain a
    forall (m :: * -> *) a.
    MonadState m =>
    (State m -> (a, State m)) -> m a
    withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
    -> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ \State CheckMain
    s -> ((), State CheckMain
    s { testPath = push (testPath s) name, indent = indent s + 2 })
        results <- (Test -> CheckMain TestResult) -> [Test] -> CheckMain [TestResult]
    forall (collection :: * -> *) (m :: * -> *) a b.
    (Mappable collection, Applicative m, Monad m) =>
    (a -> m b) -> collection a -> m (collection b)
    forall (m :: * -> *) a b.
    (Applicative m, Monad m) =>
    (a -> m b) -> [a] -> m [b]
    mapM Test -> CheckMain TestResult
    test [Test]
    list
        withState $ \State CheckMain
    s -> ((), State CheckMain
    s { testPath = pop (testPath s), indent = indent s `sizeSub` 2 })
        let totFail = [CountOf TestResult] -> Element [CountOf TestResult]
    sum ([CountOf TestResult] -> Element [CountOf TestResult])
    -> [CountOf TestResult] -> Element [CountOf TestResult]
    forall a b. (a -> b) -> a -> b
    $ (TestResult -> CountOf TestResult)
    -> [TestResult] -> [CountOf TestResult]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TestResult -> CountOf TestResult
    nbFail [TestResult]
    results
            tot = [CountOf TestResult] -> Element [CountOf TestResult]
    sum ([CountOf TestResult] -> Element [CountOf TestResult])
    -> [CountOf TestResult] -> Element [CountOf TestResult]
    forall a b. (a -> b) -> a -> b
    $ (TestResult -> CountOf TestResult)
    -> [TestResult] -> [CountOf TestResult]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TestResult -> CountOf TestResult
    nbTests [TestResult]
    results
        whenGroupOnly $ case (groupHasSubGroup list, totFail) of
            (Bool
    True, CountOf TestResult
    _)              -> () -> CheckMain ()
    forall a. a -> CheckMain a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            (Bool
    False, CountOf TestResult
    n) | CountOf TestResult
    n CountOf TestResult -> CountOf TestResult -> Bool
    forall a. Ord a => a -> a -> Bool
    > CountOf TestResult
    0     -> String -> CountOf TestResult -> String -> CheckMain ()
    displayPropertyFailed String
    name CountOf TestResult
    n String
    ""
                       | Bool
    otherwise -> String -> CountOf TestResult -> CheckMain ()
    displayPropertySucceed String
    name CountOf TestResult
    Element [CountOf TestResult]
    tot
        return $ GroupResult name totFail tot results
      where
        sum :: [CountOf TestResult] -> Element [CountOf TestResult]
    sum = (Element [CountOf TestResult]
     -> Element [CountOf TestResult] -> Element [CountOf TestResult])
    -> Element [CountOf TestResult]
    -> [CountOf TestResult]
    -> Element [CountOf TestResult]
    forall collection a.
    Foldable collection =>
    (a -> Element collection -> a) -> a -> collection -> a
    forall a.
    (a -> Element [CountOf TestResult] -> a)
    -> a -> [CountOf TestResult] -> a
    foldl' Element [CountOf TestResult]
    -> Element [CountOf TestResult] -> Element [CountOf TestResult]
    forall a. Additive a => a -> a -> a
    (+) Element [CountOf TestResult]
    0
        push :: DList String -> Element (DList String) -> DList String
    push = DList String -> Element (DList String) -> DList String
    forall c. Sequential c => c -> Element c -> c
    snoc
        pop :: DList String -> DList String
    pop = DList String
    -> ((DList String, Element (DList String)) -> DList String)
    -> Maybe (DList String, Element (DList String))
    -> DList String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe DList String
    forall a. Monoid a => a
    mempty (DList String, Element (DList String)) -> DList String
    forall a b. (a, b) -> a
    fst (Maybe (DList String, Element (DList String)) -> DList String)
    -> (DList String -> Maybe (DList String, Element (DList String)))
    -> DList String
    -> DList String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . DList String -> Maybe (DList String, Element (DList String))
    forall c. Sequential c => c -> Maybe (c, Element c)
    unsnoc

    testCheckPlan :: String -> Check () -> CheckMain TestResult
    testCheckPlan :: String -> Check () -> CheckMain TestResult
    testCheckPlan String
    name Check ()
    actions = do
        seed <- TestState -> Word64
    getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        path <- testPath <$> get
        params <- getGenParams . config <$> get
        let rngIt = Word64 -> [String] -> Word64 -> GenRng
    genRng Word64
    seed (String
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DList String -> [Item (DList String)]
    forall l. IsList l => l -> [Item l]
    toList DList String
    path)

        let planState = PlanState { planRng :: Word64 -> GenRng
    planRng         = Word64 -> GenRng
    rngIt
                                  , planValidations :: CountOf TestResult
    planValidations = CountOf TestResult
    0
                                  , planParams :: GenParams
    planParams      = GenParams
    params
                                  , planFailures :: [TestResult]
    planFailures    = []
                                  }
        st <- liftIO (snd <$> runStateT (runCheck actions) planState)
        let fails = PlanState -> [TestResult]
    planFailures PlanState
    st
        if null fails
            then return (GroupResult name 0 (planValidations st) [])
            else do
                displayCurrent name
                forM_ fails $ \TestResult
    fail -> case TestResult
    fail of
                    PropertyResult String
    name' CountOf TestResult
    nb PropertyResult
    r ->
                        case PropertyResult
    r of
                            PropertyResult
    PropertySuccess  -> CheckMain () -> CheckMain ()
    whenVerbose (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ String -> CountOf TestResult -> CheckMain ()
    displayPropertySucceed (String
    name String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    name') CountOf TestResult
    nb
                            PropertyFailed String
    w -> CheckMain () -> CheckMain ()
    whenErrorOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
    forall a b. (a -> b) -> a -> b
    $ String -> CountOf TestResult -> String -> CheckMain ()
    displayPropertyFailed (String
    name String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    name') CountOf TestResult
    nb String
    w
                    TestResult
    _ -> String -> CheckMain ()
    forall a. HasCallStack => String -> a
    error String
    "should not happen"
                return (GroupResult name (length fails) (planValidations st) fails)

    testProperty :: String -> Property -> CheckMain TestResult
    testProperty :: String -> Property -> CheckMain TestResult
    testProperty String
    name Property
    prop = do
        seed <- TestState -> Word64
    getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CheckMain (State CheckMain)
    CheckMain TestState
    forall (m :: * -> *). MonadState m => m (State m)
    get
        path <- testPath <$> get
        let rngIt = Word64 -> [String] -> Word64 -> GenRng
    genRng Word64
    seed (String
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DList String -> [Item (DList String)]
    forall l. IsList l => l -> [Item l]
    toList DList String
    path)

        params <- getGenParams . config <$> get
        maxTests <- numTests . config <$> get

        (res,nb) <- liftIO $ iterateProperty (CountOf $ integralDownsize (cast maxTests :: Int64)) params rngIt prop
        case res of
            PropertyFailed {} -> CheckMain ()
    failed
            PropertyResult
    PropertySuccess   -> CheckMain ()
    passed
        return (PropertyResult name nb res)