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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
OptionSet -> TestTree -> (StatusMap -> IO (Time -> IO a)) -> IO a
launchTestTree OptionSet
opts TestTree
testTree 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 =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ 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))
_) =
forall v. IsOption v => Proxy v -> OptionDescription
Option (forall {k} (t :: k). Proxy t
Proxy :: Proxy NumThreads) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
[OptionDescription]
coreOptions forall a. [a] -> [a] -> [a]
++
[Ingredient] -> [OptionDescription]
ingredientsOptions [Ingredient]
ins 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 forall a. [a] -> [a] -> [a]
++ [OptionDescription]
o2) 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) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \StatusMap
s -> do
(Time -> IO Bool
h1, Time -> IO Bool
h2) <- 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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Time
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&)) forall a b. (a -> b) -> a -> b
$ 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
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Only TestReporters can be composed"