{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.Sandwich.Interpreters.RunTree (
specToRunTree
, specToRunTreeVariable
, isEmptySpec
) where
import Control.Concurrent.STM
import Control.Monad.Free
import Control.Monad.Trans.RWS
import Data.Functor.Identity
import qualified Data.List as L
import Data.Sequence
import GHC.Stack
import System.FilePath
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.RunTree
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
specToRunTree :: BaseContext -> Free (SpecCommand BaseContext IO) () -> [RunNodeFixed BaseContext]
specToRunTree :: BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> [RunNodeFixed BaseContext]
specToRunTree BaseContext
baseContext Free (SpecCommand BaseContext IO) ()
spec = Identity [RunNodeFixed BaseContext] -> [RunNodeFixed BaseContext]
forall a. Identity a -> a
runIdentity (Identity [RunNodeFixed BaseContext] -> [RunNodeFixed BaseContext])
-> Identity [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> Identity [RunNodeFixed BaseContext]
forall (m :: * -> *).
Monad m =>
BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> m [RunNodeFixed BaseContext]
specToRunTreeM BaseContext
baseContext Free (SpecCommand BaseContext IO) ()
spec
specToRunTreeVariable :: BaseContext -> Free (SpecCommand BaseContext IO) () -> STM [RunNode BaseContext]
specToRunTreeVariable :: BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> STM [RunNode BaseContext]
specToRunTreeVariable BaseContext
bc Free (SpecCommand BaseContext IO) ()
spec = (RunNodeFixed BaseContext -> STM (RunNode BaseContext))
-> [RunNodeFixed BaseContext] -> STM [RunNode BaseContext]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RunNodeFixed BaseContext -> STM (RunNode BaseContext)
forall context. RunNodeFixed context -> STM (RunNode context)
unFixRunTree ([RunNodeFixed BaseContext] -> STM [RunNode BaseContext])
-> [RunNodeFixed BaseContext] -> STM [RunNode BaseContext]
forall a b. (a -> b) -> a -> b
$ BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> [RunNodeFixed BaseContext]
specToRunTree BaseContext
bc Free (SpecCommand BaseContext IO) ()
spec
isEmptySpec :: forall context. Free (SpecCommand context IO) () -> Bool
isEmptySpec :: Free (SpecCommand context IO) () -> Bool
isEmptySpec Free (SpecCommand context IO) ()
spec = [RunNodeFixed context] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [RunNodeFixed context]
ret
where context :: RunTreeContext
context = RunTreeContext :: Maybe FilePath -> Seq Int -> Int -> Int -> RunTreeContext
RunTreeContext {
runTreeIndexInParent :: Int
runTreeIndexInParent = Int
0
, runTreeNumSiblings :: Int
runTreeNumSiblings = Int
0
, runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
forall a. Monoid a => a
mempty
, runTreeCurrentFolder :: Maybe FilePath
runTreeCurrentFolder = Maybe FilePath
forall a. Maybe a
Nothing
}
([RunNodeFixed context]
ret, Int
_, ()
_) = Identity ([RunNodeFixed context], Int, ())
-> ([RunNodeFixed context], Int, ())
forall a. Identity a -> a
runIdentity (Identity ([RunNodeFixed context], Int, ())
-> ([RunNodeFixed context], Int, ()))
-> Identity ([RunNodeFixed context], Int, ())
-> ([RunNodeFixed context], Int, ())
forall a b. (a -> b) -> a -> b
$ RWST RunTreeContext () Int Identity [RunNodeFixed context]
-> RunTreeContext
-> Int
-> Identity ([RunNodeFixed context], Int, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (Free (SpecCommand context IO) ()
-> RWST RunTreeContext () Int Identity [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) ()
spec) RunTreeContext
context Int
0
specToRunTreeM :: (Monad m) => BaseContext -> Free (SpecCommand BaseContext IO) () -> m [RunNodeFixed BaseContext]
specToRunTreeM :: BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> m [RunNodeFixed BaseContext]
specToRunTreeM BaseContext
baseContext Free (SpecCommand BaseContext IO) ()
spec = do
let context :: RunTreeContext
context = RunTreeContext :: Maybe FilePath -> Seq Int -> Int -> Int -> RunTreeContext
RunTreeContext {
runTreeIndexInParent :: Int
runTreeIndexInParent = Int
0
, runTreeNumSiblings :: Int
runTreeNumSiblings = Free (SpecCommand BaseContext IO) () -> Int
forall context (m :: * -> *).
Free (SpecCommand context m) () -> Int
countChildren Free (SpecCommand BaseContext IO) ()
spec
, runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
forall a. Monoid a => a
mempty
, runTreeCurrentFolder :: Maybe FilePath
runTreeCurrentFolder = (FilePath -> FilePath -> FilePath
</> FilePath
"results") (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BaseContext -> Maybe FilePath
baseContextRunRoot BaseContext
baseContext
}
([RunNodeFixed BaseContext]
ret, Int
_, ()
_) <- RWST RunTreeContext () Int m [RunNodeFixed BaseContext]
-> RunTreeContext -> Int -> m ([RunNodeFixed BaseContext], Int, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (Free (SpecCommand BaseContext IO) ()
-> RWST RunTreeContext () Int m [RunNodeFixed BaseContext]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand BaseContext IO) ()
spec) RunTreeContext
context Int
0
[RunNodeFixed BaseContext] -> m [RunNodeFixed BaseContext]
forall (m :: * -> *) a. Monad m => a -> m a
return [RunNodeFixed BaseContext]
ret
specToRunTree' :: (Monad m) => Free (SpecCommand context IO) r -> ConvertM m [RunNodeFixed context]
specToRunTree' :: Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' (Free (Before'' Maybe SrcLoc
loc NodeOptions
no FilePath
l ExampleT context IO ()
f SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeFixed context]
-> ExampleT context IO ()
-> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus context s l t]
-> ExampleT context IO ()
-> RunNodeWithStatus context s l t
RunNodeBefore RunNodeCommonFixed
common ([RunNodeFixed context]
-> ExampleT context IO () -> RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
-> RWST
RunTreeContext
()
Int
m
(ExampleT context IO () -> RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree context IO ()
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree context IO ()
subspec RWST
RunTreeContext
()
Int
m
(ExampleT context IO () -> RunNodeFixed context)
-> RWST RunTreeContext () Int m (ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO ()
-> RWST RunTreeContext () Int m (ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
f
specToRunTree' (Free (After'' Maybe SrcLoc
loc NodeOptions
no FilePath
l ExampleT context IO ()
f SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeFixed context]
-> ExampleT context IO ()
-> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus context s l t]
-> ExampleT context IO ()
-> RunNodeWithStatus context s l t
RunNodeAfter RunNodeCommonFixed
common ([RunNodeFixed context]
-> ExampleT context IO () -> RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
-> RWST
RunTreeContext
()
Int
m
(ExampleT context IO () -> RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree context IO ()
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree context IO ()
subspec RWST
RunTreeContext
()
Int
m
(ExampleT context IO () -> RunNodeFixed context)
-> RWST RunTreeContext () Int m (ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO ()
-> RWST RunTreeContext () Int m (ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
f
specToRunTree' (Free (Introduce'' Maybe SrcLoc
loc NodeOptions
no FilePath
l Label l intro
_cl ExampleT context IO intro
alloc intro -> ExampleT context IO ()
cleanup SpecFree (LabelValue l intro :> context) IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> ExampleT context IO intro
-> (intro -> ExampleT context IO ())
-> RunNodeFixed context
forall intro s l t (lab :: Symbol) context.
Typeable intro =>
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> ExampleT context IO intro
-> (intro -> ExampleT context IO ())
-> RunNodeWithStatus context s l t
RunNodeIntroduce RunNodeCommonFixed
common ([RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> ExampleT context IO intro
-> (intro -> ExampleT context IO ())
-> RunNodeFixed context)
-> RWST
RunTreeContext
()
Int
m
[RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> RWST
RunTreeContext
()
Int
m
(ExampleT context IO intro
-> (intro -> ExampleT context IO ()) -> RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree (LabelValue l intro :> context) IO ()
-> RWST
RunTreeContext
()
Int
m
[RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree (LabelValue l intro :> context) IO ()
subspec RWST
RunTreeContext
()
Int
m
(ExampleT context IO intro
-> (intro -> ExampleT context IO ()) -> RunNodeFixed context)
-> RWST RunTreeContext () Int m (ExampleT context IO intro)
-> RWST
RunTreeContext
()
Int
m
((intro -> ExampleT context IO ()) -> RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO intro
-> RWST RunTreeContext () Int m (ExampleT context IO intro)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO intro
alloc RWST
RunTreeContext
()
Int
m
((intro -> ExampleT context IO ()) -> RunNodeFixed context)
-> RWST RunTreeContext () Int m (intro -> ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (intro -> ExampleT context IO ())
-> RWST RunTreeContext () Int m (intro -> ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure intro -> ExampleT context IO ()
cleanup
specToRunTree' (Free (IntroduceWith'' Maybe SrcLoc
loc NodeOptions
no FilePath
l Label l intro
_cl (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
action SpecFree (LabelValue l intro :> context) IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> ((intro -> ExampleT context IO [Result])
-> ExampleT context IO ())
-> RunNodeFixed context
forall s l t (lab :: Symbol) intro context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> ((intro -> ExampleT context IO [Result])
-> ExampleT context IO ())
-> RunNodeWithStatus context s l t
RunNodeIntroduceWith RunNodeCommonFixed
common ([RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> ((intro -> ExampleT context IO [Result])
-> ExampleT context IO ())
-> RunNodeFixed context)
-> RWST
RunTreeContext
()
Int
m
[RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> RWST
RunTreeContext
()
Int
m
(((intro -> ExampleT context IO [Result])
-> ExampleT context IO ())
-> RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree (LabelValue l intro :> context) IO ()
-> RWST
RunTreeContext
()
Int
m
[RunNodeWithStatus
(LabelValue l intro :> context) Status (Seq LogEntry) Bool]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree (LabelValue l intro :> context) IO ()
subspec RWST
RunTreeContext
()
Int
m
(((intro -> ExampleT context IO [Result])
-> ExampleT context IO ())
-> RunNodeFixed context)
-> RWST
RunTreeContext
()
Int
m
((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
-> RWST
RunTreeContext
()
Int
m
((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
action
specToRunTree' (Free (Around'' Maybe SrcLoc
loc NodeOptions
no FilePath
l ExampleT context IO [Result] -> ExampleT context IO ()
actionWith SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeFixed context]
-> (ExampleT context IO [Result] -> ExampleT context IO ())
-> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus context s l t]
-> (ExampleT context IO [Result] -> ExampleT context IO ())
-> RunNodeWithStatus context s l t
RunNodeAround RunNodeCommonFixed
common ([RunNodeFixed context]
-> (ExampleT context IO [Result] -> ExampleT context IO ())
-> RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
-> RWST
RunTreeContext
()
Int
m
((ExampleT context IO [Result] -> ExampleT context IO ())
-> RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree context IO ()
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree context IO ()
subspec RWST
RunTreeContext
()
Int
m
((ExampleT context IO [Result] -> ExampleT context IO ())
-> RunNodeFixed context)
-> RWST
RunTreeContext
()
Int
m
(ExampleT context IO [Result] -> ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExampleT context IO [Result] -> ExampleT context IO ())
-> RWST
RunTreeContext
()
Int
m
(ExampleT context IO [Result] -> ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO [Result] -> ExampleT context IO ()
actionWith
specToRunTree' (Free (Describe'' Maybe SrcLoc
loc NodeOptions
no FilePath
l SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeFixed context] -> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus context s l t]
-> RunNodeWithStatus context s l t
RunNodeDescribe RunNodeCommonFixed
common ([RunNodeFixed context] -> RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree context IO ()
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l NodeOptions
no RunNodeCommonFixed
common SpecFree context IO ()
subspec
specToRunTree' (Free (Parallel'' Maybe SrcLoc
loc NodeOptions
no SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
"Parallel" Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> [RunNodeFixed context] -> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> [RunNodeWithStatus context s l t]
-> RunNodeWithStatus context s l t
RunNodeParallel RunNodeCommonFixed
common ([RunNodeFixed context] -> RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> SpecFree context IO ()
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
"Parallel" NodeOptions
no RunNodeCommonFixed
common SpecFree context IO ()
subspec
specToRunTree' (Free (It'' Maybe SrcLoc
loc NodeOptions
no FilePath
l ExampleT context IO ()
example Free (SpecCommand context IO) r
next)) = do
RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *).
Monad m =>
FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc NodeOptions
no
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next (RunNodeFixed context -> ConvertM m [RunNodeFixed context])
-> RWST RunTreeContext () Int m (RunNodeFixed context)
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RunNodeCommonFixed
-> ExampleT context IO () -> RunNodeFixed context
forall s l t context.
RunNodeCommonWithStatus s l t
-> ExampleT context IO () -> RunNodeWithStatus context s l t
RunNodeIt RunNodeCommonFixed
common (ExampleT context IO () -> RunNodeFixed context)
-> RWST RunTreeContext () Int m (ExampleT context IO ())
-> RWST RunTreeContext () Int m (RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExampleT context IO ()
-> RWST RunTreeContext () Int m (ExampleT context IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
example
specToRunTree' (Pure r
_) = [RunNodeFixed context] -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a. Monad m => a -> m a
return []
type ConvertM m = RWST RunTreeContext () Int m
getCommon :: (Monad m) => String -> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon :: FilePath
-> Maybe SrcLoc -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
srcLoc (NodeOptions {Bool
Int
Maybe NodeModuleInfo
nodeOptionsModuleInfo :: NodeOptions -> Maybe NodeModuleInfo
nodeOptionsRecordTime :: NodeOptions -> Bool
nodeOptionsCreateFolder :: NodeOptions -> Bool
nodeOptionsVisibilityThreshold :: NodeOptions -> Int
nodeOptionsModuleInfo :: Maybe NodeModuleInfo
nodeOptionsRecordTime :: Bool
nodeOptionsCreateFolder :: Bool
nodeOptionsVisibilityThreshold :: Int
..}) = do
RunTreeContext {Int
Maybe FilePath
Seq Int
runTreeNumSiblings :: Int
runTreeIndexInParent :: Int
runTreeCurrentAncestors :: Seq Int
runTreeCurrentFolder :: Maybe FilePath
runTreeCurrentFolder :: RunTreeContext -> Maybe FilePath
runTreeCurrentAncestors :: RunTreeContext -> Seq Int
runTreeNumSiblings :: RunTreeContext -> Int
runTreeIndexInParent :: RunTreeContext -> Int
..} <- RWST RunTreeContext () Int m RunTreeContext
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask
Int
ident <- RWST RunTreeContext () Int m Int
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
(Int -> Int) -> RWST RunTreeContext () Int m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
RunNodeCommonFixed -> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeCommonFixed -> ConvertM m RunNodeCommonFixed)
-> RunNodeCommonFixed -> ConvertM m RunNodeCommonFixed
forall a b. (a -> b) -> a -> b
$ RunNodeCommonWithStatus :: forall s l t.
FilePath
-> Int
-> Seq Int
-> t
-> t
-> s
-> Bool
-> Maybe FilePath
-> Int
-> Bool
-> l
-> Maybe SrcLoc
-> RunNodeCommonWithStatus s l t
RunNodeCommonWithStatus {
runTreeLabel :: FilePath
runTreeLabel = FilePath
l
, runTreeId :: Int
runTreeId = Int
ident
, runTreeAncestors :: Seq Int
runTreeAncestors = Seq Int
runTreeCurrentAncestors Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
|> Int
ident
, runTreeToggled :: Bool
runTreeToggled = Bool
False
, runTreeOpen :: Bool
runTreeOpen = Bool
True
, runTreeStatus :: Status
runTreeStatus = Status
NotStarted
, runTreeVisible :: Bool
runTreeVisible = Bool
True
, runTreeFolder :: Maybe FilePath
runTreeFolder = case (Bool
nodeOptionsCreateFolder, Maybe FilePath
runTreeCurrentFolder) of
(Bool
True, Just FilePath
f) -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
f FilePath -> FilePath -> FilePath
</> (FilePath -> Int -> Int -> FilePath
nodeToFolderName FilePath
l Int
runTreeNumSiblings Int
runTreeIndexInParent))
(Bool, Maybe FilePath)
_ -> Maybe FilePath
forall a. Maybe a
Nothing
, runTreeVisibilityLevel :: Int
runTreeVisibilityLevel = Int
nodeOptionsVisibilityThreshold
, runTreeRecordTime :: Bool
runTreeRecordTime = Bool
nodeOptionsRecordTime
, runTreeLogs :: Seq LogEntry
runTreeLogs = Seq LogEntry
forall a. Monoid a => a
mempty
, runTreeLoc :: Maybe SrcLoc
runTreeLoc = Maybe SrcLoc
srcLoc
}
continueWith :: (Monad m) => Free (SpecCommand context IO) r -> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith :: Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith Free (SpecCommand context IO) r
next RunNodeFixed context
node = do
[RunNodeFixed context]
rest <- (RunTreeContext -> RunTreeContext)
-> ConvertM m [RunNodeFixed context]
-> ConvertM m [RunNodeFixed context]
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local (\RunTreeContext
rtc -> RunTreeContext
rtc { runTreeIndexInParent :: Int
runTreeIndexInParent = (RunTreeContext -> Int
runTreeIndexInParent RunTreeContext
rtc) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }) (ConvertM m [RunNodeFixed context]
-> ConvertM m [RunNodeFixed context])
-> ConvertM m [RunNodeFixed context]
-> ConvertM m [RunNodeFixed context]
forall a b. (a -> b) -> a -> b
$ Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) r
next
[RunNodeFixed context] -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) a. Monad m => a -> m a
return (RunNodeFixed context
node RunNodeFixed context
-> [RunNodeFixed context] -> [RunNodeFixed context]
forall a. a -> [a] -> [a]
: [RunNodeFixed context]
rest)
recurse :: (Monad m) => String -> NodeOptions -> RunNodeCommonFixed -> Free (SpecCommand context IO) r -> ConvertM m [RunNodeFixed context]
recurse :: FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
l (NodeOptions {Bool
Int
Maybe NodeModuleInfo
nodeOptionsModuleInfo :: Maybe NodeModuleInfo
nodeOptionsRecordTime :: Bool
nodeOptionsCreateFolder :: Bool
nodeOptionsVisibilityThreshold :: Int
nodeOptionsModuleInfo :: NodeOptions -> Maybe NodeModuleInfo
nodeOptionsRecordTime :: NodeOptions -> Bool
nodeOptionsCreateFolder :: NodeOptions -> Bool
nodeOptionsVisibilityThreshold :: NodeOptions -> Int
..}) (RunNodeCommonWithStatus {Bool
Int
FilePath
Maybe FilePath
Maybe SrcLoc
Seq Int
Seq LogEntry
Status
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Seq LogEntry
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe FilePath
runTreeVisible :: Bool
runTreeStatus :: Status
runTreeOpen :: Bool
runTreeToggled :: Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: FilePath
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe FilePath
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> FilePath
..}) Free (SpecCommand context IO) r
subspec = (RunTreeContext -> RunTreeContext)
-> ConvertM m [RunNodeFixed context]
-> ConvertM m [RunNodeFixed context]
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local
(\RunTreeContext
rtc ->
if | Bool
nodeOptionsCreateFolder ->
RunTreeContext
rtc { runTreeCurrentFolder :: Maybe FilePath
runTreeCurrentFolder = case RunTreeContext -> Maybe FilePath
runTreeCurrentFolder RunTreeContext
rtc of
Maybe FilePath
Nothing -> Maybe FilePath
forall a. Maybe a
Nothing
Just FilePath
f -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
f FilePath -> FilePath -> FilePath
</> (FilePath -> Int -> Int -> FilePath
nodeToFolderName FilePath
l (RunTreeContext -> Int
runTreeNumSiblings RunTreeContext
rtc) (RunTreeContext -> Int
runTreeIndexInParent RunTreeContext
rtc)))
, runTreeIndexInParent :: Int
runTreeIndexInParent = Int
0
, runTreeNumSiblings :: Int
runTreeNumSiblings = Free (SpecCommand context IO) r -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context IO) r
subspec
, runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
runTreeAncestors
}
| Bool
otherwise ->
RunTreeContext
rtc { runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
runTreeAncestors }
)
(Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
Monad m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) r
subspec)