{-# 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
extractNext :: forall a. Next a -> a
extractNext (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