{-# 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 context. RunNodeWithStatus context s l t -> a) -> RunNodeWithStatus context s l t -> [a]
extractValues :: forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues forall context. RunNodeWithStatus context s l t -> a
f node :: RunNodeWithStatus context s l t
node@(RunNodeIt {}) = [RunNodeWithStatus context s l t -> a
forall context. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
node]
extractValues forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus context s l t -> a
forall context. RunNodeWithStatus context s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus context s l t -> a
forall context. RunNodeWithStatus context s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues forall context. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
node = (RunNodeWithStatus context s l t -> a
forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus context s l t -> a
forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> (Bool, a)) -> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse :: forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node]
extractValuesControlRecurse forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus context s l t -> (Bool, a)
forall context. RunNodeWithStatus context s l t -> (Bool, a)
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
  (Bool
False, a
x) -> [a
x]
extractValuesControlRecurse forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus context s l t -> (Bool, a)
forall context. RunNodeWithStatus context s l t -> (Bool, a)
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
  (Bool
False, a
x) -> [a
x]
extractValuesControlRecurse forall context. RunNodeWithStatus context s l t -> (Bool, a)
f RunNodeWithStatus context s l t
node = case RunNodeWithStatus context s l t -> (Bool, a)
forall context. RunNodeWithStatus context 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 context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> (Bool, a))
-> RunNodeWithStatus context s l t -> [a]
extractValuesControlRecurse RunNodeWithStatus context s l t -> (Bool, a)
forall context. RunNodeWithStatus context 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 context.
 RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t)
-> RunNodeWithStatus context s l t
-> [RunNodeCommonWithStatus s l t]
forall s l t a context.
(forall context. RunNodeWithStatus context s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
forall context.
RunNodeWithStatus context 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 -- Note that something is running
    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
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ 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

-- isPending :: Result -> Bool
-- isPending (Failure (Pending {})) = True
-- isPending _ = 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 ()