{-# LANGUAGE RankNTypes #-}
module Test.Sandwich.RunTree (
fixRunTree
, unFixRunTree
, fixRunTree'
, extractValues
, extractValuesControlRecurse
, getCommons
, isDone
, isFailure
, isRunning
, whenFailure
, isFailureStatus
) where
import Control.Concurrent.STM
import Control.Monad.Trans
import Control.Monad.Trans.State
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
extractValues :: (forall ctx. RunNodeWithStatus ctx s l t -> a) -> RunNodeWithStatus context s l t -> [a]
forall ctx. RunNodeWithStatus ctx s l t -> a
f node :: RunNodeWithStatus context s l t
node@(RunNodeIt {}) = [RunNodeWithStatus context s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f RunNodeWithStatus context s l t
node]
extractValues forall ctx. RunNodeWithStatus ctx s l t -> a
f node :: RunNodeWithStatus context s l t
node@(RunNodeIntroduce {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented}) = (RunNodeWithStatus context s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f RunNodeWithStatus context s l t
node) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues forall ctx. RunNodeWithStatus ctx s l t -> a
f node :: RunNodeWithStatus context s l t
node@(RunNodeIntroduceWith {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented}) = (RunNodeWithStatus context s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f RunNodeWithStatus context s l t
node) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues forall ctx. RunNodeWithStatus ctx s l t -> a
f RunNodeWithStatus context s l t
node = (RunNodeWithStatus context s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f RunNodeWithStatus context s l t
node) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus context s l t -> [a])
-> [RunNodeWithStatus context s l t] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
f) (RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeWithStatus context s l t
node))
extractValuesControlRecurse :: (forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)) -> RunNodeWithStatus context s l t -> [a]
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f node :: RunNodeWithStatus context s l t
node@(RunNodeIt {}) = [(Bool, a) -> a
forall a b. (a, b) -> b
snd ((Bool, a) -> a) -> (Bool, a) -> a
forall a b. (a -> b) -> a -> b
$ RunNodeWithStatus context s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node]
extractValuesControlRecurse forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f node :: RunNodeWithStatus context s l t
node@(RunNodeIntroduce {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented}) = case RunNodeWithStatus context s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node of
(Bool
True, a
x) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus ctx s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
(Bool
False, a
x) -> [a
x]
extractValuesControlRecurse forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f node :: RunNodeWithStatus context s l t
node@(RunNodeIntroduceWith {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented}) = case RunNodeWithStatus context s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node of
(Bool
True, a
x) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus ctx s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
(Bool
False, a
x) -> [a
x]
extractValuesControlRecurse forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node = case RunNodeWithStatus context s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node of
(Bool
True, a
x) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus context s l t -> [a])
-> [RunNodeWithStatus context s l t] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus ctx s l t -> (Bool, a)
forall ctx. RunNodeWithStatus ctx s l t -> (Bool, a)
f) (RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeWithStatus context s l t
node))
(Bool
False, a
x) -> [a
x]
getCommons :: RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons :: forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons = (forall ctx.
RunNodeWithStatus ctx s l t -> RunNodeCommonWithStatus s l t)
-> RunNodeWithStatus context s l t
-> [RunNodeCommonWithStatus s l t]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> RunNodeCommonWithStatus s l t
forall ctx.
RunNodeWithStatus ctx s l t -> RunNodeCommonWithStatus s l t
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon
fixRunTree :: RunNode context -> STM (RunNodeFixed context)
fixRunTree :: forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree RunNode context
node = StateT Bool STM (RunNodeFixed context)
-> Bool -> STM (RunNodeFixed context)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' RunNode context
node) Bool
False
fixRunTree' :: RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' :: forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' node :: RunNode context
node@(RunNode context
-> RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon -> (RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
..})) = do
Status
status <- STM Status -> StateT Bool STM Status
forall (m :: * -> *) a. Monad m => m a -> StateT Bool m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM Status -> StateT Bool STM Status)
-> STM Status -> StateT Bool STM Status
forall a b. (a -> b) -> a -> b
$ Var Status -> STM Status
forall a. TVar a -> STM a
readTVar Var Status
runTreeStatus
Seq LogEntry
logs <- STM (Seq LogEntry) -> StateT Bool STM (Seq LogEntry)
forall (m :: * -> *) a. Monad m => m a -> StateT Bool m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM (Seq LogEntry) -> StateT Bool STM (Seq LogEntry))
-> STM (Seq LogEntry) -> StateT Bool STM (Seq LogEntry)
forall a b. (a -> b) -> a -> b
$ Var (Seq LogEntry) -> STM (Seq LogEntry)
forall a. TVar a -> STM a
readTVar Var (Seq LogEntry)
runTreeLogs
Bool
toggled <- STM Bool -> StateT Bool STM Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Bool m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM Bool -> StateT Bool STM Bool)
-> STM Bool -> StateT Bool STM Bool
forall a b. (a -> b) -> a -> b
$ Var Bool -> STM Bool
forall a. TVar a -> STM a
readTVar Var Bool
runTreeToggled
Bool
open <- STM Bool -> StateT Bool STM Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Bool m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (STM Bool -> StateT Bool STM Bool)
-> STM Bool -> StateT Bool STM Bool
forall a b. (a -> b) -> a -> b
$ Var Bool -> STM Bool
forall a. TVar a -> STM a
readTVar Var Bool
runTreeOpen
case Status
status of
Running {} -> Bool -> StateT Bool STM ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
True
Status
_ -> () -> StateT Bool STM ()
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let common' :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common' = RunNodeCommonWithStatus {
runTreeStatus :: Status
runTreeStatus = Status
status
, runTreeLogs :: Seq LogEntry
runTreeLogs = Seq LogEntry
logs
, runTreeToggled :: Bool
runTreeToggled = Bool
toggled
, runTreeOpen :: Bool
runTreeOpen = Bool
open
, Bool
Int
String
Maybe String
Maybe SrcLoc
Seq Int
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLoc :: Maybe SrcLoc
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLoc :: Maybe SrcLoc
..
}
case RunNode context
node of
RunNodeBefore {[RunNode context]
ExampleT context IO ()
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: [RunNode context]
runNodeBefore :: ExampleT context IO ()
runNodeBefore :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
..} -> do
[RunNodeFixed context]
children <- (RunNode context -> StateT Bool STM (RunNodeFixed context))
-> [RunNode context] -> StateT Bool STM [RunNodeFixed context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNode context]
runNodeChildren
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeBefore { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildren :: [RunNodeFixed context]
runNodeChildren=[RunNodeFixed context]
children, ExampleT context IO ()
runNodeBefore :: ExampleT context IO ()
runNodeBefore :: ExampleT context IO ()
.. }
RunNodeAfter {[RunNode context]
ExampleT context IO ()
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: [RunNode context]
runNodeAfter :: ExampleT context IO ()
runNodeAfter :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
..} -> do
[RunNodeFixed context]
children <- (RunNode context -> StateT Bool STM (RunNodeFixed context))
-> [RunNode context] -> StateT Bool STM [RunNodeFixed context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNode context]
runNodeChildren
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeAfter { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildren :: [RunNodeFixed context]
runNodeChildren=[RunNodeFixed context]
children, ExampleT context IO ()
runNodeAfter :: ExampleT context IO ()
runNodeAfter :: ExampleT context IO ()
.. }
RunNodeIntroduce {[RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
ExampleT context IO intro
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
intro -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildrenAugmented :: [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ()
runNodeCleanup :: ()
..} -> do
[RunNodeFixed (LabelValue lab intro :> context)]
children <- (RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)
-> StateT
Bool STM (RunNodeFixed (LabelValue lab intro :> context)))
-> [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
-> StateT Bool STM [RunNodeFixed (LabelValue lab intro :> context)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)
-> StateT Bool STM (RunNodeFixed (LabelValue lab intro :> context))
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
runNodeChildrenAugmented
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeIntroduce { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildrenAugmented :: [RunNodeFixed (LabelValue lab intro :> context)]
runNodeChildrenAugmented=[RunNodeFixed (LabelValue lab intro :> context)]
children, ExampleT context IO intro
intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
.. }
RunNodeIntroduceWith {[RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
(intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildrenAugmented :: [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: ()
..} -> do
[RunNodeFixed (LabelValue lab intro :> context)]
children <- (RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)
-> StateT
Bool STM (RunNodeFixed (LabelValue lab intro :> context)))
-> [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
-> StateT Bool STM [RunNodeFixed (LabelValue lab intro :> context)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)
-> StateT Bool STM (RunNodeFixed (LabelValue lab intro :> context))
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNodeWithStatus
(LabelValue lab intro :> context)
(Var Status)
(Var (Seq LogEntry))
(Var Bool)]
runNodeChildrenAugmented
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeIntroduceWith { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildrenAugmented :: [RunNodeFixed (LabelValue lab intro :> context)]
runNodeChildrenAugmented=[RunNodeFixed (LabelValue lab intro :> context)]
children, (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
.. }
RunNodeAround {[RunNode context]
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
ExampleT context IO [Result] -> ExampleT context IO ()
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: [RunNode context]
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
runNodeActionWith :: forall s l t context.
RunNodeWithStatus context s l t
-> ExampleT context IO [Result] -> ExampleT context IO ()
..} -> do
[RunNodeFixed context]
children <- (RunNode context -> StateT Bool STM (RunNodeFixed context))
-> [RunNode context] -> StateT Bool STM [RunNodeFixed context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNode context]
runNodeChildren
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeAround { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildren :: [RunNodeFixed context]
runNodeChildren=[RunNodeFixed context]
children, ExampleT context IO [Result] -> ExampleT context IO ()
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
.. }
RunNodeDescribe {[RunNode context]
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: [RunNode context]
..} -> do
[RunNodeFixed context]
children <- (RunNode context -> StateT Bool STM (RunNodeFixed context))
-> [RunNode context] -> StateT Bool STM [RunNodeFixed context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNode context]
runNodeChildren
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeDescribe { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildren :: [RunNodeFixed context]
runNodeChildren=[RunNodeFixed context]
children, .. }
RunNodeParallel {[RunNode context]
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildren :: [RunNode context]
..} -> do
[RunNodeFixed context]
children <- (RunNode context -> StateT Bool STM (RunNodeFixed context))
-> [RunNode context] -> StateT Bool STM [RunNodeFixed context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode context -> StateT Bool STM (RunNodeFixed context)
forall context.
RunNode context -> StateT Bool STM (RunNodeFixed context)
fixRunTree' [RunNode context]
runNodeChildren
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeParallel { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', runNodeChildren :: [RunNodeFixed context]
runNodeChildren=[RunNodeFixed context]
children, .. }
RunNodeIt {ExampleT context IO ()
RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeExample :: ExampleT context IO ()
runNodeExample :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
..} -> do
RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a. a -> StateT Bool STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context -> StateT Bool STM (RunNodeFixed context))
-> RunNodeFixed context -> StateT Bool STM (RunNodeFixed context)
forall a b. (a -> b) -> a -> b
$ RunNodeIt { runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon=RunNodeCommonWithStatus Status (Seq LogEntry) Bool
common', ExampleT context IO ()
runNodeExample :: ExampleT context IO ()
runNodeExample :: ExampleT context IO ()
.. }
unFixRunTree :: RunNodeFixed context -> STM (RunNode context)
unFixRunTree :: forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree node :: RunNodeFixed context
node@(RunNodeFixed context
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon -> (RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Seq Int
Seq LogEntry
Status
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Bool
runTreeOpen :: Bool
runTreeStatus :: Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Seq LogEntry
runTreeLoc :: Maybe SrcLoc
..})) = do
Var Status
status <- Status -> STM (Var Status)
forall a. a -> STM (TVar a)
newTVar Status
runTreeStatus
Var (Seq LogEntry)
logs <- Seq LogEntry -> STM (Var (Seq LogEntry))
forall a. a -> STM (TVar a)
newTVar Seq LogEntry
runTreeLogs
Var Bool
toggled <- Bool -> STM (Var Bool)
forall a. a -> STM (TVar a)
newTVar Bool
runTreeToggled
Var Bool
open <- Bool -> STM (Var Bool)
forall a. a -> STM (TVar a)
newTVar Bool
runTreeOpen
let common' :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common' = RunNodeCommonWithStatus {
runTreeStatus :: Var Status
runTreeStatus = Var Status
status
, runTreeLogs :: Var (Seq LogEntry)
runTreeLogs = Var (Seq LogEntry)
logs
, runTreeToggled :: Var Bool
runTreeToggled = Var Bool
toggled
, runTreeOpen :: Var Bool
runTreeOpen = Var Bool
open
, Bool
Int
String
Maybe String
Maybe SrcLoc
Seq Int
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLoc :: Maybe SrcLoc
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLoc :: Maybe SrcLoc
..
}
case RunNodeFixed context
node of
RunNodeBefore {[RunNodeFixed context]
ExampleT context IO ()
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeBefore :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: [RunNodeFixed context]
runNodeBefore :: ExampleT context IO ()
..} -> do
[RunNode context]
children <- (RunNodeFixed context -> STM (RunNode context))
-> [RunNodeFixed context] -> STM [RunNode context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeFixed context -> STM (RunNode context)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeFixed context]
runNodeChildren
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeBefore { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildren :: [RunNode context]
runNodeChildren=[RunNode context]
children, ExampleT context IO ()
runNodeBefore :: ExampleT context IO ()
runNodeBefore :: ExampleT context IO ()
.. }
RunNodeAfter {[RunNodeFixed context]
ExampleT context IO ()
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeAfter :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: [RunNodeFixed context]
runNodeAfter :: ExampleT context IO ()
..} -> do
[RunNode context]
children <- (RunNodeFixed context -> STM (RunNode context))
-> [RunNodeFixed context] -> STM [RunNode context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeFixed context -> STM (RunNode context)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeFixed context]
runNodeChildren
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeAfter { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildren :: [RunNode context]
runNodeChildren=[RunNode context]
children, ExampleT context IO ()
runNodeAfter :: ExampleT context IO ()
runNodeAfter :: ExampleT context IO ()
.. }
RunNodeIntroduce {[RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
ExampleT context IO intro
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
intro -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeAlloc :: ()
runNodeCleanup :: ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
..} -> do
[RunNode (LabelValue lab intro :> context)]
children <- (RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool
-> STM (RunNode (LabelValue lab intro :> context)))
-> [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
-> STM [RunNode (LabelValue lab intro :> context)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool
-> STM (RunNode (LabelValue lab intro :> context))
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeIntroduce { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildrenAugmented :: [RunNode (LabelValue lab intro :> context)]
runNodeChildrenAugmented=[RunNode (LabelValue lab intro :> context)]
children, ExampleT context IO intro
intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
.. }
RunNodeIntroduceWith {[RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
(intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeIntroduceAction :: ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
..} -> do
[RunNode (LabelValue lab intro :> context)]
children <- (RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool
-> STM (RunNode (LabelValue lab intro :> context)))
-> [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
-> STM [RunNode (LabelValue lab intro :> context)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool
-> STM (RunNode (LabelValue lab intro :> context))
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeWithStatus
(LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeIntroduceWith { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildrenAugmented :: [RunNode (LabelValue lab intro :> context)]
runNodeChildrenAugmented=[RunNode (LabelValue lab intro :> context)]
children, (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
.. }
RunNodeAround {[RunNodeFixed context]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
ExampleT context IO [Result] -> ExampleT context IO ()
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeActionWith :: forall s l t context.
RunNodeWithStatus context s l t
-> ExampleT context IO [Result] -> ExampleT context IO ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: [RunNodeFixed context]
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
..} -> do
[RunNode context]
children <- (RunNodeFixed context -> STM (RunNode context))
-> [RunNodeFixed context] -> STM [RunNode context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeFixed context -> STM (RunNode context)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeFixed context]
runNodeChildren
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeAround { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildren :: [RunNode context]
runNodeChildren=[RunNode context]
children, ExampleT context IO [Result] -> ExampleT context IO ()
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
runNodeActionWith :: ExampleT context IO [Result] -> ExampleT context IO ()
.. }
RunNodeDescribe {[RunNodeFixed context]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: [RunNodeFixed context]
..} -> do
[RunNode context]
children <- (RunNodeFixed context -> STM (RunNode context))
-> [RunNodeFixed context] -> STM [RunNode context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeFixed context -> STM (RunNode context)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeFixed context]
runNodeChildren
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeDescribe { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildren :: [RunNode context]
runNodeChildren=[RunNode context]
children, .. }
RunNodeParallel {[RunNodeFixed context]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildren :: [RunNodeFixed context]
..} -> do
[RunNode context]
children <- (RunNodeFixed context -> STM (RunNode context))
-> [RunNodeFixed context] -> STM [RunNode context]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNodeFixed context -> STM (RunNode context)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree [RunNodeFixed context]
runNodeChildren
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeParallel { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', runNodeChildren :: [RunNode context]
runNodeChildren=[RunNode context]
children, .. }
RunNodeIt {ExampleT context IO ()
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeExample :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeExample :: ExampleT context IO ()
..} -> do
RunNode context -> STM (RunNode context)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNode context -> STM (RunNode context))
-> RunNode context -> STM (RunNode context)
forall a b. (a -> b) -> a -> b
$ RunNodeIt { runNodeCommon :: RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon=RunNodeCommonWithStatus
(Var Status) (Var (Seq LogEntry)) (Var Bool)
common', ExampleT context IO ()
runNodeExample :: ExampleT context IO ()
runNodeExample :: ExampleT context IO ()
.. }
isDone :: Status -> Bool
isDone :: Status -> Bool
isDone (Done {}) = Bool
True
isDone Status
_ = Bool
False
isRunning :: Status -> Bool
isRunning :: Status -> Bool
isRunning (Running {}) = Bool
True
isRunning Status
_ = Bool
False
isFailureStatus :: Status -> Bool
isFailureStatus :: Status -> Bool
isFailureStatus (Done UTCTime
_ Maybe UTCTime
_ Maybe UTCTime
_ UTCTime
_ Result
stat) = Result -> Bool
isFailure Result
stat
isFailureStatus Status
_ = Bool
False
isFailure :: Result -> Bool
isFailure :: Result -> Bool
isFailure (Failure (Pending {})) = Bool
False
isFailure (Failure {}) = Bool
True
isFailure Result
_ = Bool
False
whenFailure :: (Monad m) => Result -> (FailureReason -> m ()) -> m ()
whenFailure :: forall (m :: * -> *).
Monad m =>
Result -> (FailureReason -> m ()) -> m ()
whenFailure (Failure (Pending {})) FailureReason -> m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenFailure (Failure FailureReason
reason) FailureReason -> m ()
action = FailureReason -> m ()
action FailureReason
reason
whenFailure Result
_ FailureReason -> m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()