{-# 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 Data.Kind
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word
import GHC.Stack
import Test.QuickCheck.IO ()
import Test.Syd.HList
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 (((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

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 (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td e
e -> Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> f
-> SpecDefTree a c f
forall (outers :: [*]) inner extra.
Text
-> TDef
     (((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef (((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

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 (((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

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 (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
td u
e -> Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> w
-> SpecDefTree a c w
forall (outers :: [*]) inner extra.
Text
-> TDef
     (((HList outers -> inner -> IO ()) -> IO ()) -> IO TestRunResult)
-> extra
-> SpecDefTree outers inner extra
DefSpecifyNode Text
t TDef (((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

data Parallelism = Parallel | Sequential

data ExecutionOrderRandomisation = RandomiseExecutionOrder | DoNotRandomiseExecutionOrder

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 String
Maybe Word
Maybe (Either String Assertion)
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe GoldenCase
TestStatus
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 (Either String Assertion)
testRunResultStatus :: TestRunResult -> TestStatus
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 (Either String Assertion)
testRunResultStatus :: TestStatus
..} Word64
t) CallStack
_) ->
        TestSuiteStats :: Word
-> Word -> Word -> Word64 -> Maybe (Text, Word64) -> TestSuiteStats
TestSuiteStats
          { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = case TestStatus
testRunResultStatus of
              TestStatus
TestPassed -> Word
1
              TestStatus
TestFailed -> Word
0,
            testSuiteStatFailures :: Word
testSuiteStatFailures = case TestStatus
testRunResultStatus of
              TestStatus
TestPassed -> Word
0
              TestStatus
TestFailed -> 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 -> Word64 -> Maybe (Text, Word64) -> TestSuiteStats
TestSuiteStats
          { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = Word
0,
            testSuiteStatFailures :: Word
testSuiteStatFailures = 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
testSuiteStatFailures :: !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 -> 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,
        testSuiteStatFailures :: Word
testSuiteStatFailures = TestSuiteStats -> Word
testSuiteStatFailures TestSuiteStats
tss1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ TestSuiteStats -> Word
testSuiteStatFailures 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 -> Word64 -> Maybe (Text, Word64) -> TestSuiteStats
TestSuiteStats
      { testSuiteStatSuccesses :: Word
testSuiteStatSuccesses = Word
0,
        testSuiteStatFailures :: Word
testSuiteStatFailures = 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 :: ResultForest -> Bool
shouldExitFail :: ResultForest -> Bool
shouldExitFail = (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 ((TestStatus -> TestStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TestStatus
TestFailed) (TestStatus -> Bool)
-> (TDef (Timed TestRunResult) -> TestStatus)
-> TDef (Timed TestRunResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRunResult -> TestStatus
testRunResultStatus (TestRunResult -> TestStatus)
-> (TDef (Timed TestRunResult) -> TestRunResult)
-> TDef (Timed TestRunResult)
-> TestStatus
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))