{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Syd.Runner.Wrappers where
import Control.Concurrent
import Control.Monad.IO.Class
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.SpecDef
data Next a = Continue a | Stop a
deriving (forall a b. a -> Next b -> Next a
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Next b -> Next a
$c<$ :: forall a b. a -> Next b -> Next a
fmap :: forall a b. (a -> b) -> Next a -> Next b
$cfmap :: forall a b. (a -> b) -> Next a -> Next b
Functor)
extractNext :: Next a -> a
(Continue a
a) = a
a
extractNext (Stop a
a) = a
a
failFastNext :: Settings -> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))
failFastNext :: Settings
-> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))
failFastNext Settings
settings td :: TDef (Timed TestRunReport)
td@(TDef (Timed TestRunReport
trr Word64
_) CallStack
_) =
if Settings -> Bool
settingFailFast Settings
settings Bool -> Bool -> Bool
&& Settings -> TestRunReport -> Bool
testRunReportFailed Settings
settings TestRunReport
trr
then forall a. a -> Next a
Stop TDef (Timed TestRunReport)
td
else forall a. a -> Next a
Continue TDef (Timed TestRunReport)
td
applySimpleWrapper ::
MonadIO m =>
((a -> m ()) -> (b -> m ())) ->
(a -> m r) ->
(b -> m r)
applySimpleWrapper :: forall (m :: * -> *) a b r.
MonadIO m =>
((a -> m ()) -> b -> m ()) -> (a -> m r) -> b -> m r
applySimpleWrapper (a -> m ()) -> b -> m ()
takeTakeA a -> m r
takeA b
b = do
MVar r
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
(a -> m ()) -> b -> m ()
takeTakeA
( \a
a -> do
r
r <- a -> m r
takeA a
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar r
var r
r
)
b
b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar r
var
applySimpleWrapper' ::
MonadIO m =>
((a -> m ()) -> m ()) ->
(a -> m r) ->
m r
applySimpleWrapper' :: forall (m :: * -> *) a r.
MonadIO m =>
((a -> m ()) -> m ()) -> (a -> m r) -> m r
applySimpleWrapper' (a -> m ()) -> m ()
takeTakeA a -> m r
takeA = do
MVar r
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
(a -> m ()) -> m ()
takeTakeA
( \a
a -> do
r
r <- a -> m r
takeA a
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar r
var r
r
)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar r
var
applySimpleWrapper'' ::
MonadIO m =>
(m () -> m ()) ->
m r ->
m r
applySimpleWrapper'' :: forall (m :: * -> *) r. MonadIO m => (m () -> m ()) -> m r -> m r
applySimpleWrapper'' m () -> m ()
wrapper m r
produceResult = do
MVar r
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
m () -> m ()
wrapper forall a b. (a -> b) -> a -> b
$ do
r
r <- m r
produceResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar r
var r
r
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar r
var
applySimpleWrapper2 ::
MonadIO m =>
((a -> b -> m ()) -> (c -> d -> m ())) ->
(a -> b -> m r) ->
(c -> d -> m r)
applySimpleWrapper2 :: forall (m :: * -> *) a b c d r.
MonadIO m =>
((a -> b -> m ()) -> c -> d -> m ())
-> (a -> b -> m r) -> c -> d -> m r
applySimpleWrapper2 (a -> b -> m ()) -> c -> d -> m ()
takeTakeAB a -> b -> m r
takeAB c
c d
d = do
MVar r
var <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
(a -> b -> m ()) -> c -> d -> m ()
takeTakeAB
( \a
a b
b -> do
r
r <- a -> b -> m r
takeAB a
a b
b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar r
var r
r
)
c
c
d
d
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
readMVar MVar r
var