module Test.Tasty.Ingredients
( Ingredient(..)
, tryIngredients
, ingredientOptions
, ingredientsOptions
, suiteOptions
, composeReporters
) where
import Control.Monad
import Data.Proxy
import qualified Data.Foldable as F
import Test.Tasty.Core
import Test.Tasty.Run
import Test.Tasty.Options
import Test.Tasty.Options.Core
import Control.Concurrent.Async (concurrently)
data Ingredient
= TestReporter
[OptionDescription]
(OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
| TestManager
[OptionDescription]
(OptionSet -> TestTree -> Maybe (IO Bool))
tryIngredient :: Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredient :: Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredient (TestReporter [OptionDescription]
_ OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
report) OptionSet
opts TestTree
testTree = do
StatusMap -> IO (Time -> IO Bool)
reportFn <- OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
report OptionSet
opts TestTree
testTree
IO Bool -> Maybe (IO Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO Bool -> Maybe (IO Bool)) -> IO Bool -> Maybe (IO Bool)
forall a b. (a -> b) -> a -> b
$ OptionSet
-> TestTree -> (StatusMap -> IO (Time -> IO Bool)) -> IO Bool
forall a.
OptionSet -> TestTree -> (StatusMap -> IO (Time -> IO a)) -> IO a
launchTestTree OptionSet
opts TestTree
testTree ((StatusMap -> IO (Time -> IO Bool)) -> IO Bool)
-> (StatusMap -> IO (Time -> IO Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> StatusMap -> IO (Time -> IO Bool)
reportFn StatusMap
smap
tryIngredient (TestManager [OptionDescription]
_ OptionSet -> TestTree -> Maybe (IO Bool)
manage) OptionSet
opts TestTree
testTree =
OptionSet -> TestTree -> Maybe (IO Bool)
manage OptionSet
opts TestTree
testTree
tryIngredients :: [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredients :: [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredients [Ingredient]
ins OptionSet
opts TestTree
tree =
[Maybe (IO Bool)] -> Maybe (IO Bool)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe (IO Bool)] -> Maybe (IO Bool))
-> [Maybe (IO Bool)] -> Maybe (IO Bool)
forall a b. (a -> b) -> a -> b
$ (Ingredient -> Maybe (IO Bool))
-> [Ingredient] -> [Maybe (IO Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Ingredient
i -> Ingredient -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredient Ingredient
i OptionSet
opts TestTree
tree) [Ingredient]
ins
ingredientOptions :: Ingredient -> [OptionDescription]
ingredientOptions :: Ingredient -> [OptionDescription]
ingredientOptions (TestReporter [OptionDescription]
opts OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
_) =
Proxy NumThreads -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy NumThreads
forall k (t :: k). Proxy t
Proxy :: Proxy NumThreads) OptionDescription -> [OptionDescription] -> [OptionDescription]
forall a. a -> [a] -> [a]
: [OptionDescription]
opts
ingredientOptions (TestManager [OptionDescription]
opts OptionSet -> TestTree -> Maybe (IO Bool)
_) = [OptionDescription]
opts
ingredientsOptions :: [Ingredient] -> [OptionDescription]
ingredientsOptions :: [Ingredient] -> [OptionDescription]
ingredientsOptions = [OptionDescription] -> [OptionDescription]
uniqueOptionDescriptions ([OptionDescription] -> [OptionDescription])
-> ([Ingredient] -> [OptionDescription])
-> [Ingredient]
-> [OptionDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ingredient -> [OptionDescription])
-> [Ingredient] -> [OptionDescription]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Ingredient -> [OptionDescription]
ingredientOptions
suiteOptions :: [Ingredient] -> TestTree -> [OptionDescription]
suiteOptions :: [Ingredient] -> TestTree -> [OptionDescription]
suiteOptions [Ingredient]
ins TestTree
tree = [OptionDescription] -> [OptionDescription]
uniqueOptionDescriptions ([OptionDescription] -> [OptionDescription])
-> [OptionDescription] -> [OptionDescription]
forall a b. (a -> b) -> a -> b
$
[OptionDescription]
coreOptions [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++
[Ingredient] -> [OptionDescription]
ingredientsOptions [Ingredient]
ins [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++
TestTree -> [OptionDescription]
treeOptions TestTree
tree
composeReporters :: Ingredient -> Ingredient -> Ingredient
composeReporters :: Ingredient -> Ingredient -> Ingredient
composeReporters (TestReporter [OptionDescription]
o1 OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
f1) (TestReporter [OptionDescription]
o2 OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
f2) =
[OptionDescription]
-> (OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
-> Ingredient
TestReporter ([OptionDescription]
o1 [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++ [OptionDescription]
o2) ((OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
-> Ingredient)
-> (OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
o TestTree
t ->
case (OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
f1 OptionSet
o TestTree
t, OptionSet -> TestTree -> Maybe (StatusMap -> IO (Time -> IO Bool))
f2 OptionSet
o TestTree
t) of
(Maybe (StatusMap -> IO (Time -> IO Bool))
g, Maybe (StatusMap -> IO (Time -> IO Bool))
Nothing) -> Maybe (StatusMap -> IO (Time -> IO Bool))
g
(Maybe (StatusMap -> IO (Time -> IO Bool))
Nothing, Maybe (StatusMap -> IO (Time -> IO Bool))
g) -> Maybe (StatusMap -> IO (Time -> IO Bool))
g
(Just StatusMap -> IO (Time -> IO Bool)
g1, Just StatusMap -> IO (Time -> IO Bool)
g2) -> (StatusMap -> IO (Time -> IO Bool))
-> Maybe (StatusMap -> IO (Time -> IO Bool))
forall a. a -> Maybe a
Just ((StatusMap -> IO (Time -> IO Bool))
-> Maybe (StatusMap -> IO (Time -> IO Bool)))
-> (StatusMap -> IO (Time -> IO Bool))
-> Maybe (StatusMap -> IO (Time -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
s -> do
(Time -> IO Bool
h1, Time -> IO Bool
h2) <- IO (Time -> IO Bool)
-> IO (Time -> IO Bool) -> IO (Time -> IO Bool, Time -> IO Bool)
forall a b. IO a -> IO b -> IO (a, b)
concurrently (StatusMap -> IO (Time -> IO Bool)
g1 StatusMap
s) (StatusMap -> IO (Time -> IO Bool)
g2 StatusMap
s)
(Time -> IO Bool) -> IO (Time -> IO Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Time -> IO Bool) -> IO (Time -> IO Bool))
-> (Time -> IO Bool) -> IO (Time -> IO Bool)
forall a b. (a -> b) -> a -> b
$ \Time
x -> ((Bool, Bool) -> Bool) -> IO (Bool, Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&)) (IO (Bool, Bool) -> IO Bool) -> IO (Bool, Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ IO Bool -> IO Bool -> IO (Bool, Bool)
forall a b. IO a -> IO b -> IO (a, b)
concurrently (Time -> IO Bool
h1 Time
x) (Time -> IO Bool
h2 Time
x)
composeReporters Ingredient
_ Ingredient
_ = [Char] -> Ingredient
forall a. HasCallStack => [Char] -> a
error [Char]
"Only TestReporters can be composed"