{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- | This module defines all the functions you will use to define your test suite.
module Test.Syd.SpecDef where

import Control.Monad
import Control.Monad.Random
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Kind
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word
import GHC.Stack
import System.Random.Shuffle
import Test.QuickCheck.IO ()
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecForest

data TDef value = TDef {TDef value -> value
testDefVal :: value, TDef value -> CallStack
testDefCallStack :: CallStack}
  deriving (a -> TDef b -> TDef a
(a -> b) -> TDef a -> TDef b
(forall a b. (a -> b) -> TDef a -> TDef b)
-> (forall a b. a -> TDef b -> TDef a) -> Functor TDef
forall a b. a -> TDef b -> TDef a
forall a b. (a -> b) -> TDef a -> TDef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TDef b -> TDef a
$c<$ :: forall a b. a -> TDef b -> TDef a
fmap :: (a -> b) -> TDef a -> TDef b
$cfmap :: forall a b. (a -> b) -> TDef a -> TDef b
Functor, TDef a -> Bool
(a -> m) -> TDef a -> m
(a -> b -> b) -> b -> TDef a -> b
(forall m. Monoid m => TDef m -> m)
-> (forall m a. Monoid m => (a -> m) -> TDef a -> m)
-> (forall m a. Monoid m => (a -> m) -> TDef a -> m)
-> (forall a b. (a -> b -> b) -> b -> TDef a -> b)
-> (forall a b. (a -> b -> b) -> b -> TDef a -> b)
-> (forall b a. (b -> a -> b) -> b -> TDef a -> b)
-> (forall b a. (b -> a -> b) -> b -> TDef a -> b)
-> (forall a. (a -> a -> a) -> TDef a -> a)
-> (forall a. (a -> a -> a) -> TDef a -> a)
-> (forall a. TDef a -> [a])
-> (forall a. TDef a -> Bool)
-> (forall a. TDef a -> Int)
-> (forall a. Eq a => a -> TDef a -> Bool)
-> (forall a. Ord a => TDef a -> a)
-> (forall a. Ord a => TDef a -> a)
-> (forall a. Num a => TDef a -> a)
-> (forall a. Num a => TDef a -> a)
-> Foldable TDef
forall a. Eq a => a -> TDef a -> Bool
forall a. Num a => TDef a -> a
forall a. Ord a => TDef a -> a
forall m. Monoid m => TDef m -> m
forall a. TDef a -> Bool
forall a. TDef a -> Int
forall a. TDef a -> [a]
forall a. (a -> a -> a) -> TDef a -> a
forall m a. Monoid m => (a -> m) -> TDef a -> m
forall b a. (b -> a -> b) -> b -> TDef a -> b
forall a b. (a -> b -> b) -> b -> TDef a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: TDef a -> a
$cproduct :: forall a. Num a => TDef a -> a
sum :: TDef a -> a
$csum :: forall a. Num a => TDef a -> a
minimum :: TDef a -> a
$cminimum :: forall a. Ord a => TDef a -> a
maximum :: TDef a -> a
$cmaximum :: forall a. Ord a => TDef a -> a
elem :: a -> TDef a -> Bool
$celem :: forall a. Eq a => a -> TDef a -> Bool
length :: TDef a -> Int
$clength :: forall a. TDef a -> Int
null :: TDef a -> Bool
$cnull :: forall a. TDef a -> Bool
toList :: TDef a -> [a]
$ctoList :: forall a. TDef a -> [a]
foldl1 :: (a -> a -> a) -> TDef a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TDef a -> a
foldr1 :: (a -> a -> a) -> TDef a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TDef a -> a
foldl' :: (b -> a -> b) -> b -> TDef a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TDef a -> b
foldl :: (b -> a -> b) -> b -> TDef a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TDef a -> b
foldr' :: (a -> b -> b) -> b -> TDef a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TDef a -> b
foldr :: (a -> b -> b) -> b -> TDef a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TDef a -> b
foldMap' :: (a -> m) -> TDef a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TDef a -> m
foldMap :: (a -> m) -> TDef a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TDef a -> m
fold :: TDef m -> m
$cfold :: forall m. Monoid m => TDef m -> m
Foldable, Functor TDef
Foldable TDef
Functor TDef
-> Foldable TDef
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TDef a -> f (TDef b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TDef (f a) -> f (TDef a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TDef a -> m (TDef b))
-> (forall (m :: * -> *) a. Monad m => TDef (m a) -> m (TDef a))
-> Traversable TDef
(a -> f b) -> TDef a -> f (TDef b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TDef (m a) -> m (TDef a)
forall (f :: * -> *) a. Applicative f => TDef (f a) -> f (TDef a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TDef a -> m (TDef b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TDef a -> f (TDef b)
sequence :: TDef (m a) -> m (TDef a)
$csequence :: forall (m :: * -> *) a. Monad m => TDef (m a) -> m (TDef a)
mapM :: (a -> m b) -> TDef a -> m (TDef b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TDef a -> m (TDef b)
sequenceA :: TDef (f a) -> f (TDef a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => TDef (f a) -> f (TDef a)
traverse :: (a -> f b) -> TDef a -> f (TDef b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TDef a -> f (TDef b)
$cp2Traversable :: Foldable TDef
$cp1Traversable :: Functor TDef
Traversable)

type TestForest outers inner = SpecDefForest outers inner ()

type TestTree outers inner = SpecDefTree outers inner ()

type SpecDefForest (outers :: [Type]) inner extra = [SpecDefTree outers inner extra]

-- | A tree of tests
--
-- This type has three parameters:
--
-- * @outers@: A type-level list of the outer resources. These are resources that are prived once, around a group of tests. (This is the type of the results of `aroundAll`.)
-- * @inner@: The inner resource. This is a resource that is set up around every test, and even every example of a property test. (This is the type of the result of `around`.)
-- * @result@: The result ('TestDefM' is a monad.)
--
-- In practice, all of these three parameters should be '()' at the top level.
--
-- When you're just using sydtest and not writing a library for sydtest, you probably don't even want to concern yourself with this type.
data SpecDefTree (outers :: [Type]) inner extra where
  -- | Define a test
  DefSpecifyNode ::
    -- | The description of the test
    Text ->
    -- | How the test can be run given a function that provides the resources
    TDef (ProgressReporter -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult) ->
    extra ->
    SpecDefTree outers inner extra
  -- | Define a pending test
  DefPendingNode ::
    -- | The description of the test
    Text ->
    -- | The reason why the test is pending
    Maybe Text ->
    SpecDefTree outers inner extra
  -- | Group tests using a description
  DefDescribeNode ::
    -- | The description
    Text ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra
  DefWrapNode ::
    -- | The function that wraps running the tests.
    (IO () -> IO ()) ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra
  DefBeforeAllNode ::
    -- | The function to run (once), beforehand, to produce the outer resource.
    IO outer ->
    SpecDefForest (outer ': otherOuters) inner extra ->
    SpecDefTree otherOuters inner extra
  DefAroundAllNode ::
    -- | The function that provides the outer resource (once), around the tests.
    ((outer -> IO ()) -> IO ()) ->
    SpecDefForest (outer ': otherOuters) inner extra ->
    SpecDefTree otherOuters inner extra
  DefAroundAllWithNode ::
    -- | The function that provides the new outer resource (once), using the old outer resource.
    ((newOuter -> IO ()) -> (oldOuter -> IO ())) ->
    SpecDefForest (newOuter ': oldOuter ': otherOuters) inner extra ->
    SpecDefTree (oldOuter ': otherOuters) inner extra
  DefAfterAllNode ::
    -- | The function to run (once), afterwards, using all outer resources.
    (HList outers -> IO ()) ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra
  -- | Control the level of parallelism for a given group of tests
  DefParallelismNode ::
    -- | The level of parallelism
    Parallelism ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra
  -- | Control the execution order randomisation for a given group of tests
  DefRandomisationNode ::
    -- | The execution order randomisation
    ExecutionOrderRandomisation ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra
  DefFlakinessNode ::
    -- | How many times to retry
    FlakinessMode ->
    SpecDefForest outers inner extra ->
    SpecDefTree outers inner extra

instance Functor (SpecDefTree a c) where
  fmap :: forall e f. (e -> f) -> SpecDefTree a c e -> SpecDefTree a c f
  fmap :: (e -> f) -> SpecDefTree a c e -> SpecDefTree a c f
fmap e -> f
f =
    let goF :: forall x y. SpecDefForest x y e -> SpecDefForest x y f
        goF :: SpecDefForest x y e -> SpecDefForest x y f
goF = (SpecDefTree x y e -> SpecDefTree x y f)
-> SpecDefForest x y e -> SpecDefForest x y f
forall a b. (a -> b) -> [a] -> [b]
map ((e -> f) -> SpecDefTree x y e -> SpecDefTree x y f
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> f
f)
     in \case
          DefDescribeNode Text
t SpecDefForest a c e
sdf -> Text -> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
t (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf
          DefPendingNode Text
t Maybe Text
mr -> Text -> Maybe Text -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
t Maybe Text
mr
          DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td e
e -> Text
-> TDef
     (ProgressReporter
      -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> f
-> SpecDefTree a c f
forall (outers :: [*]) inner extra.
Text
-> TDef
     (ProgressReporter
      -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td (e -> f
f e
e)
          DefWrapNode IO () -> IO ()
func SpecDefForest a c e
sdf -> (IO () -> IO ()) -> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf
          DefBeforeAllNode IO outer
func SpecDefForest (outer : a) c e
sdf -> IO outer -> SpecDefForest (outer : a) c f -> SpecDefTree a c f
forall outer (otherOuters :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
func (SpecDefForest (outer : a) c f -> SpecDefTree a c f)
-> SpecDefForest (outer : a) c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest (outer : a) c e -> SpecDefForest (outer : a) c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest (outer : a) c e
sdf
          DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) c e
sdf -> ((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : a) c f -> SpecDefTree a c f
forall outer (otherOuters :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func (SpecDefForest (outer : a) c f -> SpecDefTree a c f)
-> SpecDefForest (outer : a) c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest (outer : a) c e -> SpecDefForest (outer : a) c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest (outer : a) c e
sdf
          DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) c e
sdf -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) c f
-> SpecDefTree (oldOuter : otherOuters) c f
forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func (SpecDefForest (newOuter : oldOuter : otherOuters) c f
 -> SpecDefTree (oldOuter : otherOuters) c f)
-> SpecDefForest (newOuter : oldOuter : otherOuters) c f
-> SpecDefTree (oldOuter : otherOuters) c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest (newOuter : oldOuter : otherOuters) c e
-> SpecDefForest (newOuter : oldOuter : otherOuters) c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest (newOuter : oldOuter : otherOuters) c e
sdf
          DefAfterAllNode HList a -> IO ()
func SpecDefForest a c e
sdf -> (HList a -> IO ()) -> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList a -> IO ()
func (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf
          DefParallelismNode Parallelism
p SpecDefForest a c e
sdf -> Parallelism -> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
p (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf
          DefRandomisationNode ExecutionOrderRandomisation
p SpecDefForest a c e
sdf -> ExecutionOrderRandomisation
-> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
p (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf
          DefFlakinessNode FlakinessMode
p SpecDefForest a c e
sdf -> FlakinessMode -> SpecDefForest a c f -> SpecDefTree a c f
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
p (SpecDefForest a c f -> SpecDefTree a c f)
-> SpecDefForest a c f -> SpecDefTree a c f
forall a b. (a -> b) -> a -> b
$ SpecDefForest a c e -> SpecDefForest a c f
forall (x :: [*]) y. SpecDefForest x y e -> SpecDefForest x y f
goF SpecDefForest a c e
sdf

instance Foldable (SpecDefTree a c) where
  foldMap :: forall e m. Monoid m => (e -> m) -> SpecDefTree a c e -> m
  foldMap :: (e -> m) -> SpecDefTree a c e -> m
foldMap e -> m
f =
    let goF :: forall x y. SpecDefForest x y e -> m
        goF :: SpecDefForest x y e -> m
goF = (SpecDefTree x y e -> m) -> SpecDefForest x y e -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((e -> m) -> SpecDefTree x y e -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap e -> m
f)
     in \case
          DefDescribeNode Text
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf
          DefPendingNode Text
_ Maybe Text
_ -> m
forall a. Monoid a => a
mempty
          DefSpecifyNode Text
_ TDef
  (ProgressReporter
   -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
_ e
e -> e -> m
f e
e
          DefWrapNode IO () -> IO ()
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf
          DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) c e
sdf -> SpecDefForest (outer : a) c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest (outer : a) c e
sdf
          DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) c e
sdf -> SpecDefForest (outer : a) c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest (outer : a) c e
sdf
          DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest (newOuter : oldOuter : otherOuters) c e
sdf -> SpecDefForest (newOuter : oldOuter : otherOuters) c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest (newOuter : oldOuter : otherOuters) c e
sdf
          DefAfterAllNode HList a -> IO ()
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf
          DefParallelismNode Parallelism
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf
          DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf
          DefFlakinessNode FlakinessMode
_ SpecDefForest a c e
sdf -> SpecDefForest a c e -> m
forall (x :: [*]) y. SpecDefForest x y e -> m
goF SpecDefForest a c e
sdf

instance Traversable (SpecDefTree a c) where
  traverse :: forall u w f. Applicative f => (u -> f w) -> SpecDefTree a c u -> f (SpecDefTree a c w)
  traverse :: (u -> f w) -> SpecDefTree a c u -> f (SpecDefTree a c w)
traverse u -> f w
f =
    let goF :: forall x y. SpecDefForest x y u -> f (SpecDefForest x y w)
        goF :: SpecDefForest x y u -> f (SpecDefForest x y w)
goF = (SpecDefTree x y u -> f (SpecDefTree x y w))
-> SpecDefForest x y u -> f (SpecDefForest x y w)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((u -> f w) -> SpecDefTree x y u -> f (SpecDefTree x y w)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse u -> f w
f)
     in \case
          DefDescribeNode Text
t SpecDefForest a c u
sdf -> Text -> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
t (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf
          DefPendingNode Text
t Maybe Text
mr -> SpecDefTree a c w -> f (SpecDefTree a c w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecDefTree a c w -> f (SpecDefTree a c w))
-> SpecDefTree a c w -> f (SpecDefTree a c w)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
t Maybe Text
mr
          DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td u
e -> Text
-> TDef
     (ProgressReporter
      -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> w
-> SpecDefTree a c w
forall (outers :: [*]) inner extra.
Text
-> TDef
     (ProgressReporter
      -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td (w -> SpecDefTree a c w) -> f w -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> f w
f u
e
          DefWrapNode IO () -> IO ()
func SpecDefForest a c u
sdf -> (IO () -> IO ()) -> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf
          DefBeforeAllNode IO outer
func SpecDefForest (outer : a) c u
sdf -> IO outer -> SpecDefForest (outer : a) c w -> SpecDefTree a c w
forall outer (otherOuters :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
func (SpecDefForest (outer : a) c w -> SpecDefTree a c w)
-> f (SpecDefForest (outer : a) c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) c u -> f (SpecDefForest (outer : a) c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest (outer : a) c u
sdf
          DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) c u
sdf -> ((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : a) c w -> SpecDefTree a c w
forall outer (otherOuters :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func (SpecDefForest (outer : a) c w -> SpecDefTree a c w)
-> f (SpecDefForest (outer : a) c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) c u -> f (SpecDefForest (outer : a) c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest (outer : a) c u
sdf
          DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) c u
sdf -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) c w
-> SpecDefTree (oldOuter : otherOuters) c w
forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func (SpecDefForest (newOuter : oldOuter : otherOuters) c w
 -> SpecDefTree (oldOuter : otherOuters) c w)
-> f (SpecDefForest (newOuter : oldOuter : otherOuters) c w)
-> f (SpecDefTree (oldOuter : otherOuters) c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (newOuter : oldOuter : otherOuters) c u
-> f (SpecDefForest (newOuter : oldOuter : otherOuters) c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest (newOuter : oldOuter : otherOuters) c u
sdf
          DefAfterAllNode HList a -> IO ()
func SpecDefForest a c u
sdf -> (HList a -> IO ()) -> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList a -> IO ()
func (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf
          DefParallelismNode Parallelism
p SpecDefForest a c u
sdf -> Parallelism -> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
p (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf
          DefRandomisationNode ExecutionOrderRandomisation
p SpecDefForest a c u
sdf -> ExecutionOrderRandomisation
-> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
p (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf
          DefFlakinessNode FlakinessMode
p SpecDefForest a c u
sdf -> FlakinessMode -> SpecDefForest a c w -> SpecDefTree a c w
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
p (SpecDefForest a c w -> SpecDefTree a c w)
-> f (SpecDefForest a c w) -> f (SpecDefTree a c w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a c u -> f (SpecDefForest a c w)
forall (x :: [*]) y. SpecDefForest x y u -> f (SpecDefForest x y w)
goF SpecDefForest a c u
sdf

filterTestForest :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result
filterTestForest :: Maybe Text
-> SpecDefForest outers inner result
-> SpecDefForest outers inner result
filterTestForest Maybe Text
mf = SpecDefForest outers inner result
-> Maybe (SpecDefForest outers inner result)
-> SpecDefForest outers inner result
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe (SpecDefForest outers inner result)
 -> SpecDefForest outers inner result)
-> (SpecDefForest outers inner result
    -> Maybe (SpecDefForest outers inner result))
-> SpecDefForest outers inner result
-> SpecDefForest outers inner result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList Text
-> SpecDefForest outers inner result
-> Maybe (SpecDefForest outers inner result)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
forall a. DList a
DList.empty
  where
    goForest :: DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
    goForest :: DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
ts SpecDefForest a b c
sdf = do
      let sdf' :: SpecDefForest a b c
sdf' = (SpecDefTree a b c -> Maybe (SpecDefTree a b c))
-> SpecDefForest a b c -> SpecDefForest a b c
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
goTree DList Text
ts) SpecDefForest a b c
sdf
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SpecDefForest a b c -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null SpecDefForest a b c
sdf'
      SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpecDefForest a b c
sdf'

    filterGuard :: DList Text -> Bool
    filterGuard :: DList Text -> Bool
filterGuard DList Text
dl = case Maybe Text
mf of
      Just Text
f -> Text
f Text -> Text -> Bool
`T.isInfixOf` Text -> [Text] -> Text
T.intercalate Text
"." (DList Text -> [Text]
forall a. DList a -> [a]
DList.toList DList Text
dl)
      Maybe Text
Nothing -> Bool
True

    goTree :: DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
    goTree :: DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
goTree DList Text
dl = \case
      DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td c
e -> do
        let tl :: DList Text
tl = DList Text -> Text -> DList Text
forall a. DList a -> a -> DList a
DList.snoc DList Text
dl Text
t
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ DList Text -> Bool
filterGuard DList Text
tl
        SpecDefTree a b c -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecDefTree a b c -> Maybe (SpecDefTree a b c))
-> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
forall a b. (a -> b) -> a -> b
$ Text
-> TDef
     (ProgressReporter
      -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
-> c
-> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text
-> TDef
     (ProgressReporter
      -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td c
e
      DefPendingNode Text
t Maybe Text
mr -> do
        let tl :: DList Text
tl = DList Text -> Text -> DList Text
forall a. DList a -> a -> DList a
DList.snoc DList Text
dl Text
t
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ DList Text -> Bool
filterGuard DList Text
tl
        SpecDefTree a b c -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecDefTree a b c -> Maybe (SpecDefTree a b c))
-> SpecDefTree a b c -> Maybe (SpecDefTree a b c)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
t Maybe Text
mr
      DefDescribeNode Text
t SpecDefForest a b c
sdf -> Text -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
t (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest (DList Text -> Text -> DList Text
forall a. DList a -> a -> DList a
DList.snoc DList Text
dl Text
t) SpecDefForest a b c
sdf
      DefWrapNode IO () -> IO ()
func SpecDefForest a b c
sdf -> (IO () -> IO ()) -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest a b c
sdf
      DefBeforeAllNode IO outer
func SpecDefForest (outer : a) b c
sdf -> IO outer -> SpecDefForest (outer : a) b c -> SpecDefTree a b c
forall outer (otherOuters :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
func (SpecDefForest (outer : a) b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest (outer : a) b c)
-> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text
-> SpecDefForest (outer : a) b c
-> Maybe (SpecDefForest (outer : a) b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest (outer : a) b c
sdf
      DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) b c
sdf -> ((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : a) b c -> SpecDefTree a b c
forall outer (otherOuters :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func (SpecDefForest (outer : a) b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest (outer : a) b c)
-> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text
-> SpecDefForest (outer : a) b c
-> Maybe (SpecDefForest (outer : a) b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest (outer : a) b c
sdf
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) b c
-> SpecDefTree (oldOuter : otherOuters) b c
forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func (SpecDefForest (newOuter : oldOuter : otherOuters) b c
 -> SpecDefTree (oldOuter : otherOuters) b c)
-> Maybe (SpecDefForest (newOuter : oldOuter : otherOuters) b c)
-> Maybe (SpecDefTree (oldOuter : otherOuters) b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text
-> SpecDefForest (newOuter : oldOuter : otherOuters) b c
-> Maybe (SpecDefForest (newOuter : oldOuter : otherOuters) b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf
      DefAfterAllNode HList a -> IO ()
func SpecDefForest a b c
sdf -> (HList a -> IO ()) -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList a -> IO ()
func (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest a b c
sdf
      DefParallelismNode Parallelism
func SpecDefForest a b c
sdf -> Parallelism -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
func (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest a b c
sdf
      DefRandomisationNode ExecutionOrderRandomisation
func SpecDefForest a b c
sdf -> ExecutionOrderRandomisation
-> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
func (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest a b c
sdf
      DefFlakinessNode FlakinessMode
func SpecDefForest a b c
sdf -> FlakinessMode -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
func (SpecDefForest a b c -> SpecDefTree a b c)
-> Maybe (SpecDefForest a b c) -> Maybe (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
forall (a :: [*]) b c.
DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)
goForest DList Text
dl SpecDefForest a b c
sdf

randomiseTestForest :: MonadRandom m => SpecDefForest outers inner result -> m (SpecDefForest outers inner result)
randomiseTestForest :: SpecDefForest outers inner result
-> m (SpecDefForest outers inner result)
randomiseTestForest = SpecDefForest outers inner result
-> m (SpecDefForest outers inner result)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest
  where
    goForest :: MonadRandom m => SpecDefForest a b c -> m (SpecDefForest a b c)
    goForest :: SpecDefForest a b c -> m (SpecDefForest a b c)
goForest = (SpecDefTree a b c -> m (SpecDefTree a b c))
-> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SpecDefTree a b c -> m (SpecDefTree a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefTree a b c -> m (SpecDefTree a b c)
goTree (SpecDefForest a b c -> m (SpecDefForest a b c))
-> (SpecDefForest a b c -> m (SpecDefForest a b c))
-> SpecDefForest a b c
-> m (SpecDefForest a b c)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
shuffleM
    goTree :: MonadRandom m => SpecDefTree a b c -> m (SpecDefTree a b c)
    goTree :: SpecDefTree a b c -> m (SpecDefTree a b c)
goTree = \case
      DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td c
e -> SpecDefTree a b c -> m (SpecDefTree a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecDefTree a b c -> m (SpecDefTree a b c))
-> SpecDefTree a b c -> m (SpecDefTree a b c)
forall a b. (a -> b) -> a -> b
$ Text
-> TDef
     (ProgressReporter
      -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
-> c
-> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text
-> TDef
     (ProgressReporter
      -> ((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td c
e
      DefPendingNode Text
t Maybe Text
mr -> SpecDefTree a b c -> m (SpecDefTree a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpecDefTree a b c -> m (SpecDefTree a b c))
-> SpecDefTree a b c -> m (SpecDefTree a b c)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text -> Maybe Text -> SpecDefTree outers inner extra
DefPendingNode Text
t Maybe Text
mr
      DefDescribeNode Text
t SpecDefForest a b c
sdf -> Text -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Text
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefDescribeNode Text
t (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
      DefWrapNode IO () -> IO ()
func SpecDefForest a b c
sdf -> (IO () -> IO ()) -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
(IO () -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefWrapNode IO () -> IO ()
func (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
      DefBeforeAllNode IO outer
func SpecDefForest (outer : a) b c
sdf -> IO outer -> SpecDefForest (outer : a) b c -> SpecDefTree a b c
forall outer (otherOuters :: [*]) inner extra.
IO outer
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefBeforeAllNode IO outer
func (SpecDefForest (outer : a) b c -> SpecDefTree a b c)
-> m (SpecDefForest (outer : a) b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b c -> m (SpecDefForest (outer : a) b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest (outer : a) b c
sdf
      DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) b c
sdf -> ((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : a) b c -> SpecDefTree a b c
forall outer (otherOuters :: [*]) inner extra.
((outer -> IO ()) -> IO ())
-> SpecDefForest (outer : otherOuters) inner extra
-> SpecDefTree otherOuters inner extra
DefAroundAllNode (outer -> IO ()) -> IO ()
func (SpecDefForest (outer : a) b c -> SpecDefTree a b c)
-> m (SpecDefForest (outer : a) b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b c -> m (SpecDefForest (outer : a) b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest (outer : a) b c
sdf
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf -> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) b c
-> SpecDefTree (oldOuter : otherOuters) b c
forall newOuter oldOuter (otherOuters :: [*]) inner extra.
((newOuter -> IO ()) -> oldOuter -> IO ())
-> SpecDefForest (newOuter : oldOuter : otherOuters) inner extra
-> SpecDefTree (oldOuter : otherOuters) inner extra
DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func (SpecDefForest (newOuter : oldOuter : otherOuters) b c
 -> SpecDefTree (oldOuter : otherOuters) b c)
-> m (SpecDefForest (newOuter : oldOuter : otherOuters) b c)
-> m (SpecDefTree (oldOuter : otherOuters) b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (newOuter : oldOuter : otherOuters) b c
-> m (SpecDefForest (newOuter : oldOuter : otherOuters) b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest (newOuter : oldOuter : otherOuters) b c
sdf
      DefAfterAllNode HList a -> IO ()
func SpecDefForest a b c
sdf -> (HList a -> IO ()) -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
(HList outers -> IO ())
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefAfterAllNode HList a -> IO ()
func (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
      DefParallelismNode Parallelism
func SpecDefForest a b c
sdf -> Parallelism -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
Parallelism
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefParallelismNode Parallelism
func (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
      DefFlakinessNode FlakinessMode
i SpecDefForest a b c
sdf -> FlakinessMode -> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
FlakinessMode
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefFlakinessNode FlakinessMode
i (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
      DefRandomisationNode ExecutionOrderRandomisation
eor SpecDefForest a b c
sdf ->
        ExecutionOrderRandomisation
-> SpecDefForest a b c -> SpecDefTree a b c
forall (outers :: [*]) inner extra.
ExecutionOrderRandomisation
-> SpecDefForest outers inner extra
-> SpecDefTree outers inner extra
DefRandomisationNode ExecutionOrderRandomisation
eor (SpecDefForest a b c -> SpecDefTree a b c)
-> m (SpecDefForest a b c) -> m (SpecDefTree a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ExecutionOrderRandomisation
eor of
          ExecutionOrderRandomisation
RandomiseExecutionOrder -> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (m :: * -> *) (a :: [*]) b c.
MonadRandom m =>
SpecDefForest a b c -> m (SpecDefForest a b c)
goForest SpecDefForest a b c
sdf
          ExecutionOrderRandomisation
DoNotRandomiseExecutionOrder -> SpecDefForest a b c -> m (SpecDefForest a b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpecDefForest a b c
sdf

data Parallelism = Parallel | Sequential

data ExecutionOrderRandomisation = RandomiseExecutionOrder | DoNotRandomiseExecutionOrder

data FlakinessMode
  = MayNotBeFlaky
  | MayBeFlakyUpTo
      !Int
      !(Maybe String) -- A message to show whenever the test is flaky.

type ResultForest = SpecForest (TDef (Timed TestRunResult))

type ResultTree = SpecTree (TDef (Timed TestRunResult))

computeTestSuiteStats :: ResultForest -> TestSuiteStats
computeTestSuiteStats :: ResultForest -> TestSuiteStats
computeTestSuiteStats = [Text] -> ResultForest -> TestSuiteStats
goF []
  where
    goF :: [Text] -> ResultForest -> TestSuiteStats
    goF :: [Text] -> ResultForest -> TestSuiteStats
goF [Text]
ts = (ResultTree -> TestSuiteStats) -> ResultForest -> TestSuiteStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Text] -> ResultTree -> TestSuiteStats
goT [Text]
ts)
    goT :: [Text] -> ResultTree -> TestSuiteStats
    goT :: [Text] -> ResultTree -> TestSuiteStats
goT [Text]
ts = \case
      SpecifyNode Text
tn (TDef (Timed TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultFlakinessMessage :: TestRunResult -> Maybe String
testRunResultExtraInfo :: TestRunResult -> Maybe String
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultRetries :: TestRunResult -> Maybe Int
testRunResultStatus :: TestRunResult -> TestStatus
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
..} Word64
t) CallStack
_) ->
        TestSuiteStats :: Word
-> Word
-> Word
-> Word
-> Word
-> Word64
-> Maybe (Text, Word64)
-> TestSuiteStats
TestSuiteStats
          { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = case TestStatus
testRunResultStatus of
              TestStatus
TestPassed -> Word
1
              TestStatus
TestFailed -> Word
0,
            testSuiteStatExamples :: Word
testSuiteStatExamples = case TestStatus
testRunResultStatus of
              TestStatus
TestPassed -> Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
1 Maybe Word
testRunResultNumTests
              TestStatus
TestFailed -> Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
1 Maybe Word
testRunResultNumTests Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
0 Maybe Word
testRunResultNumShrinks,
            testSuiteStatFailures :: Word
testSuiteStatFailures = case TestStatus
testRunResultStatus of
              TestStatus
TestPassed -> Word
0
              TestStatus
TestFailed -> Word
1,
            testSuiteStatFlakyTests :: Word
testSuiteStatFlakyTests = case TestStatus
testRunResultStatus of
              TestStatus
TestFailed -> Word
0
              TestStatus
TestPassed -> case Maybe Int
testRunResultRetries of
                Maybe Int
Nothing -> Word
0
                Just Int
_ -> Word
1,
            testSuiteStatPending :: Word
testSuiteStatPending = Word
0,
            testSuiteStatSumTime :: Word64
testSuiteStatSumTime = Word64
t,
            testSuiteStatLongestTime :: Maybe (Text, Word64)
testSuiteStatLongestTime = (Text, Word64) -> Maybe (Text, Word64)
forall a. a -> Maybe a
Just (Text -> [Text] -> Text
T.intercalate Text
"." ([Text]
ts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
tn]), Word64
t)
          }
      PendingNode Text
_ Maybe Text
_ ->
        TestSuiteStats :: Word
-> Word
-> Word
-> Word
-> Word
-> Word64
-> Maybe (Text, Word64)
-> TestSuiteStats
TestSuiteStats
          { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = Word
0,
            testSuiteStatExamples :: Word
testSuiteStatExamples = Word
0,
            testSuiteStatFailures :: Word
testSuiteStatFailures = Word
0,
            testSuiteStatFlakyTests :: Word
testSuiteStatFlakyTests = Word
0,
            testSuiteStatPending :: Word
testSuiteStatPending = Word
1,
            testSuiteStatSumTime :: Word64
testSuiteStatSumTime = Word64
0,
            testSuiteStatLongestTime :: Maybe (Text, Word64)
testSuiteStatLongestTime = Maybe (Text, Word64)
forall a. Maybe a
Nothing
          }
      DescribeNode Text
t ResultForest
sf -> [Text] -> ResultForest -> TestSuiteStats
goF (Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts) ResultForest
sf
      SubForestNode ResultForest
sf -> [Text] -> ResultForest -> TestSuiteStats
goF [Text]
ts ResultForest
sf

data TestSuiteStats = TestSuiteStats
  { TestSuiteStats -> Word
testSuiteStatSuccesses :: !Word,
    TestSuiteStats -> Word
testSuiteStatExamples :: !Word,
    TestSuiteStats -> Word
testSuiteStatFailures :: !Word,
    TestSuiteStats -> Word
testSuiteStatFlakyTests :: !Word,
    TestSuiteStats -> Word
testSuiteStatPending :: !Word,
    TestSuiteStats -> Word64
testSuiteStatSumTime :: !Word64,
    TestSuiteStats -> Maybe (Text, Word64)
testSuiteStatLongestTime :: !(Maybe (Text, Word64))
  }
  deriving (Int -> TestSuiteStats -> ShowS
[TestSuiteStats] -> ShowS
TestSuiteStats -> String
(Int -> TestSuiteStats -> ShowS)
-> (TestSuiteStats -> String)
-> ([TestSuiteStats] -> ShowS)
-> Show TestSuiteStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestSuiteStats] -> ShowS
$cshowList :: [TestSuiteStats] -> ShowS
show :: TestSuiteStats -> String
$cshow :: TestSuiteStats -> String
showsPrec :: Int -> TestSuiteStats -> ShowS
$cshowsPrec :: Int -> TestSuiteStats -> ShowS
Show, TestSuiteStats -> TestSuiteStats -> Bool
(TestSuiteStats -> TestSuiteStats -> Bool)
-> (TestSuiteStats -> TestSuiteStats -> Bool) -> Eq TestSuiteStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestSuiteStats -> TestSuiteStats -> Bool
$c/= :: TestSuiteStats -> TestSuiteStats -> Bool
== :: TestSuiteStats -> TestSuiteStats -> Bool
$c== :: TestSuiteStats -> TestSuiteStats -> Bool
Eq)

instance Semigroup TestSuiteStats where
  <> :: TestSuiteStats -> TestSuiteStats -> TestSuiteStats
(<>) TestSuiteStats
tss1 TestSuiteStats
tss2 =
    TestSuiteStats :: Word
-> Word
-> Word
-> Word
-> Word
-> Word64
-> Maybe (Text, Word64)
-> TestSuiteStats
TestSuiteStats
      { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = TestSuiteStats -> Word
testSuiteStatSuccesses TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatSuccesses TestSuiteStats
tss2,
        testSuiteStatExamples :: Word
testSuiteStatExamples = TestSuiteStats -> Word
testSuiteStatExamples TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatExamples TestSuiteStats
tss2,
        testSuiteStatFailures :: Word
testSuiteStatFailures = TestSuiteStats -> Word
testSuiteStatFailures TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatFailures TestSuiteStats
tss2,
        testSuiteStatFlakyTests :: Word
testSuiteStatFlakyTests = TestSuiteStats -> Word
testSuiteStatFlakyTests TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatFlakyTests TestSuiteStats
tss2,
        testSuiteStatPending :: Word
testSuiteStatPending = TestSuiteStats -> Word
testSuiteStatPending TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatPending TestSuiteStats
tss2,
        testSuiteStatSumTime :: Word64
testSuiteStatSumTime = TestSuiteStats -> Word64
testSuiteStatSumTime TestSuiteStats
tss1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word64
testSuiteStatSumTime TestSuiteStats
tss2,
        testSuiteStatLongestTime :: Maybe (Text, Word64)
testSuiteStatLongestTime = case (TestSuiteStats -> Maybe (Text, Word64)
testSuiteStatLongestTime TestSuiteStats
tss1, TestSuiteStats -> Maybe (Text, Word64)
testSuiteStatLongestTime TestSuiteStats
tss2) of
          (Maybe (Text, Word64)
Nothing, Maybe (Text, Word64)
Nothing) -> Maybe (Text, Word64)
forall a. Maybe a
Nothing
          (Just (Text, Word64)
t1, Maybe (Text, Word64)
Nothing) -> (Text, Word64) -> Maybe (Text, Word64)
forall a. a -> Maybe a
Just (Text, Word64)
t1
          (Maybe (Text, Word64)
Nothing, Just (Text, Word64)
t2) -> (Text, Word64) -> Maybe (Text, Word64)
forall a. a -> Maybe a
Just (Text, Word64)
t2
          (Just (Text
tn1, Word64
t1), Just (Text
tn2, Word64
t2)) -> (Text, Word64) -> Maybe (Text, Word64)
forall a. a -> Maybe a
Just ((Text, Word64) -> Maybe (Text, Word64))
-> (Text, Word64) -> Maybe (Text, Word64)
forall a b. (a -> b) -> a -> b
$ if Word64
t1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
t2 then (Text
tn1, Word64
t1) else (Text
tn2, Word64
t2)
      }

instance Monoid TestSuiteStats where
  mappend :: TestSuiteStats -> TestSuiteStats -> TestSuiteStats
mappend = TestSuiteStats -> TestSuiteStats -> TestSuiteStats
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: TestSuiteStats
mempty =
    TestSuiteStats :: Word
-> Word
-> Word
-> Word
-> Word
-> Word64
-> Maybe (Text, Word64)
-> TestSuiteStats
TestSuiteStats
      { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = Word
0,
        testSuiteStatExamples :: Word
testSuiteStatExamples = Word
0,
        testSuiteStatFailures :: Word
testSuiteStatFailures = Word
0,
        testSuiteStatFlakyTests :: Word
testSuiteStatFlakyTests = Word
0,
        testSuiteStatPending :: Word
testSuiteStatPending = Word
0,
        testSuiteStatSumTime :: Word64
testSuiteStatSumTime = Word64
0,
        testSuiteStatLongestTime :: Maybe (Text, Word64)
testSuiteStatLongestTime = Maybe (Text, Word64)
forall a. Maybe a
Nothing
      }

shouldExitFail :: Settings -> ResultForest -> Bool
shouldExitFail :: Settings -> ResultForest -> Bool
shouldExitFail Settings
settings = (ResultTree -> Bool) -> ResultForest -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((TDef (Timed TestRunResult) -> Bool) -> ResultTree -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Settings -> TestRunResult -> Bool
testFailed Settings
settings (TestRunResult -> Bool)
-> (TDef (Timed TestRunResult) -> TestRunResult)
-> TDef (Timed TestRunResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed TestRunResult -> TestRunResult
forall a. Timed a -> a
timedValue (Timed TestRunResult -> TestRunResult)
-> (TDef (Timed TestRunResult) -> Timed TestRunResult)
-> TDef (Timed TestRunResult)
-> TestRunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TDef (Timed TestRunResult) -> Timed TestRunResult
forall value. TDef value -> value
testDefVal))

testFailed :: Settings -> TestRunResult -> Bool
testFailed :: Settings -> TestRunResult -> Bool
testFailed Settings {Bool
Int
Maybe Bool
Maybe Text
SeedSetting
ReportProgress
Iterations
Threads
settingDebug :: Settings -> Bool
settingReportProgress :: Settings -> ReportProgress
settingFailOnFlaky :: Settings -> Bool
settingIterations :: Settings -> Iterations
settingFailFast :: Settings -> Bool
settingFilter :: Settings -> Maybe Text
settingColour :: Settings -> Maybe Bool
settingGoldenReset :: Settings -> Bool
settingGoldenStart :: Settings -> Bool
settingMaxShrinks :: Settings -> Int
settingMaxDiscard :: Settings -> Int
settingMaxSize :: Settings -> Int
settingMaxSuccess :: Settings -> Int
settingThreads :: Settings -> Threads
settingRandomiseExecutionOrder :: Settings -> Bool
settingSeed :: Settings -> SeedSetting
settingDebug :: Bool
settingReportProgress :: ReportProgress
settingFailOnFlaky :: Bool
settingIterations :: Iterations
settingFailFast :: Bool
settingFilter :: Maybe Text
settingColour :: Maybe Bool
settingGoldenReset :: Bool
settingGoldenStart :: Bool
settingMaxShrinks :: Int
settingMaxDiscard :: Int
settingMaxSize :: Int
settingMaxSuccess :: Int
settingThreads :: Threads
settingRandomiseExecutionOrder :: Bool
settingSeed :: SeedSetting
..} TestRunResult {[String]
Maybe Int
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
testRunResultFlakinessMessage :: Maybe String
testRunResultExtraInfo :: Maybe String
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultClasses :: Maybe (Map String Int)
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultFailingInputs :: [String]
testRunResultNumShrinks :: Maybe Word
testRunResultNumTests :: Maybe Word
testRunResultException :: Maybe SomeException
testRunResultRetries :: Maybe Int
testRunResultStatus :: TestStatus
testRunResultFlakinessMessage :: TestRunResult -> Maybe String
testRunResultExtraInfo :: TestRunResult -> Maybe String
testRunResultGoldenCase :: TestRunResult -> Maybe GoldenCase
testRunResultTables :: TestRunResult -> Maybe (Map String (Map String Int))
testRunResultClasses :: TestRunResult -> Maybe (Map String Int)
testRunResultLabels :: TestRunResult -> Maybe (Map [String] Int)
testRunResultFailingInputs :: TestRunResult -> [String]
testRunResultNumShrinks :: TestRunResult -> Maybe Word
testRunResultNumTests :: TestRunResult -> Maybe Word
testRunResultException :: TestRunResult -> Maybe SomeException
testRunResultRetries :: TestRunResult -> Maybe Int
testRunResultStatus :: TestRunResult -> TestStatus
..} =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ -- Failed
      TestStatus
testRunResultStatus TestStatus -> TestStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TestStatus
TestFailed,
      -- Passed but flaky and flakiness isn't allowed
      Bool
settingFailOnFlaky Bool -> Bool -> Bool
&& TestStatus
testRunResultStatus TestStatus -> TestStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TestStatus
TestPassed Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
testRunResultRetries
    ]