{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module Test.Sandwich.Interpreters.RunTree (
  specToRunTree
  , specToRunTreeVariable
  , specToRunTreeM
  , isEmptySpec
  ) where

import Control.Concurrent.STM
import Control.Monad.Free
import Control.Monad.Logger
import Control.Monad.Trans.RWS
import Data.Foldable (toList)
import Data.Functor.Identity
import qualified Data.List as L
import qualified Data.Map as M
import Data.Sequence as Seq
import GHC.Stack
import Lens.Micro
import Lens.Micro.TH
import Safe (headMay)
import System.FilePath
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.RunTree (unFixRunTree)
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec


data CreatedNode = CreatedNode {
  CreatedNode -> Maybe (FilePath, Int, Int)
_createdNodeFolder :: Maybe (FilePath, Int, Int)
  } deriving (Int -> CreatedNode -> ShowS
[CreatedNode] -> ShowS
CreatedNode -> FilePath
(Int -> CreatedNode -> ShowS)
-> (CreatedNode -> FilePath)
-> ([CreatedNode] -> ShowS)
-> Show CreatedNode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedNode -> ShowS
showsPrec :: Int -> CreatedNode -> ShowS
$cshow :: CreatedNode -> FilePath
show :: CreatedNode -> FilePath
$cshowList :: [CreatedNode] -> ShowS
showList :: [CreatedNode] -> ShowS
Show)
makeLenses ''CreatedNode

data ConvertState = ConvertState {
  ConvertState -> Int
_convertStateIdCounter :: Int
  , ConvertState -> Map Int CreatedNode
_convertStateCreatedNodes :: M.Map Int CreatedNode
  , ConvertState -> Int
_convertStateRootNextChildIndex :: Int
  }
emptyConvertState :: ConvertState
emptyConvertState :: ConvertState
emptyConvertState = Int -> Map Int CreatedNode -> Int -> ConvertState
ConvertState Int
0 Map Int CreatedNode
forall a. Monoid a => a
mempty Int
0
makeLenses ''ConvertState

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
$ NoLoggingT Identity [RunNodeFixed BaseContext]
-> Identity [RunNodeFixed BaseContext]
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT Identity [RunNodeFixed BaseContext]
 -> Identity [RunNodeFixed BaseContext])
-> NoLoggingT Identity [RunNodeFixed BaseContext]
-> Identity [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> NoLoggingT Identity [RunNodeFixed BaseContext]
forall (m :: * -> *).
MonadLogger 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: forall context. Free (SpecCommand context IO) () -> Bool
isEmptySpec Free (SpecCommand context IO) ()
spec = [RunNodeFixed context] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [RunNodeFixed context]
ret
  where context :: RunTreeContext
context = RunTreeContext {
          runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
forall a. Monoid a => a
mempty
          , runTreeRootFolderAndNumChildren :: Maybe (FilePath, Int)
runTreeRootFolderAndNumChildren = Maybe (FilePath, Int)
forall a. Maybe a
Nothing
          }
        ([RunNodeFixed context]
ret, ConvertState
_, ()
_) = Identity ([RunNodeFixed context], ConvertState, ())
-> ([RunNodeFixed context], ConvertState, ())
forall a. Identity a -> a
runIdentity (Identity ([RunNodeFixed context], ConvertState, ())
 -> ([RunNodeFixed context], ConvertState, ()))
-> Identity ([RunNodeFixed context], ConvertState, ())
-> ([RunNodeFixed context], ConvertState, ())
forall a b. (a -> b) -> a -> b
$ NoLoggingT Identity ([RunNodeFixed context], ConvertState, ())
-> Identity ([RunNodeFixed context], ConvertState, ())
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (NoLoggingT Identity ([RunNodeFixed context], ConvertState, ())
 -> Identity ([RunNodeFixed context], ConvertState, ()))
-> NoLoggingT Identity ([RunNodeFixed context], ConvertState, ())
-> Identity ([RunNodeFixed context], ConvertState, ())
forall a b. (a -> b) -> a -> b
$ RWST
  RunTreeContext
  ()
  ConvertState
  (NoLoggingT Identity)
  [RunNodeFixed context]
-> RunTreeContext
-> ConvertState
-> NoLoggingT Identity ([RunNodeFixed context], ConvertState, ())
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
     ()
     ConvertState
     (NoLoggingT Identity)
     [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) ()
spec) RunTreeContext
context ConvertState
emptyConvertState

specToRunTreeM :: (MonadLogger m) => BaseContext -> Free (SpecCommand BaseContext IO) () -> m [RunNodeFixed BaseContext]
specToRunTreeM :: forall (m :: * -> *).
MonadLogger m =>
BaseContext
-> Free (SpecCommand BaseContext IO) ()
-> m [RunNodeFixed BaseContext]
specToRunTreeM BaseContext
baseContext Free (SpecCommand BaseContext IO) ()
spec = do
  let context :: RunTreeContext
context = RunTreeContext {
        runTreeCurrentAncestors :: Seq Int
runTreeCurrentAncestors = Seq Int
forall a. Monoid a => a
mempty
        , runTreeRootFolderAndNumChildren :: Maybe (FilePath, Int)
runTreeRootFolderAndNumChildren = case BaseContext -> Maybe FilePath
baseContextRunRoot BaseContext
baseContext of
            Maybe FilePath
Nothing -> Maybe (FilePath, Int)
forall a. Maybe a
Nothing
            Just FilePath
root -> (FilePath, Int) -> Maybe (FilePath, Int)
forall a. a -> Maybe a
Just (FilePath
root FilePath -> ShowS
</> FilePath
"results", Free (SpecCommand BaseContext IO) () -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand BaseContext IO) ()
spec)
        }
  ([RunNodeFixed BaseContext]
ret, ConvertState
_, ()
_) <- RWST RunTreeContext () ConvertState m [RunNodeFixed BaseContext]
-> RunTreeContext
-> ConvertState
-> m ([RunNodeFixed BaseContext], ConvertState, ())
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 () ConvertState m [RunNodeFixed BaseContext]
forall (m :: * -> *) context r.
MonadLogger m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand BaseContext IO) ()
spec) RunTreeContext
context ConvertState
emptyConvertState
  [RunNodeFixed BaseContext] -> m [RunNodeFixed BaseContext]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [RunNodeFixed BaseContext]
ret

-- | Convert a spec to a run tree
specToRunTree' :: (MonadLogger m) => Free (SpecCommand context IO) r -> ConvertM m [RunNodeFixed context]
specToRunTree' :: forall (m :: * -> *) context r.
MonadLogger m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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
     ()
     ConvertState
     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.
MonadLogger 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
  ()
  ConvertState
  m
  (ExampleT context IO () -> RunNodeFixed context)
-> RWST RunTreeContext () ConvertState m (ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO ()
-> RWST RunTreeContext () ConvertState m (ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
f
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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
     ()
     ConvertState
     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.
MonadLogger 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
  ()
  ConvertState
  m
  (ExampleT context IO () -> RunNodeFixed context)
-> RWST RunTreeContext () ConvertState m (ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO ()
-> RWST RunTreeContext () ConvertState m (ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
f
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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
     ()
     ConvertState
     m
     [RunNodeWithStatus
        (LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> RWST
     RunTreeContext
     ()
     ConvertState
     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
     ()
     ConvertState
     m
     [RunNodeWithStatus
        (LabelValue l intro :> context) Status (Seq LogEntry) Bool]
forall (m :: * -> *) context r.
MonadLogger 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
  ()
  ConvertState
  m
  (ExampleT context IO intro
   -> (intro -> ExampleT context IO ()) -> RunNodeFixed context)
-> RWST
     RunTreeContext () ConvertState m (ExampleT context IO intro)
-> RWST
     RunTreeContext
     ()
     ConvertState
     m
     ((intro -> ExampleT context IO ()) -> RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExampleT context IO intro
-> RWST
     RunTreeContext () ConvertState m (ExampleT context IO intro)
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO intro
alloc RWST
  RunTreeContext
  ()
  ConvertState
  m
  ((intro -> ExampleT context IO ()) -> RunNodeFixed context)
-> RWST
     RunTreeContext () ConvertState m (intro -> ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (intro -> ExampleT context IO ())
-> RWST
     RunTreeContext () ConvertState m (intro -> ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure intro -> ExampleT context IO ()
cleanup
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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
     ()
     ConvertState
     m
     [RunNodeWithStatus
        (LabelValue l intro :> context) Status (Seq LogEntry) Bool]
-> RWST
     RunTreeContext
     ()
     ConvertState
     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
     ()
     ConvertState
     m
     [RunNodeWithStatus
        (LabelValue l intro :> context) Status (Seq LogEntry) Bool]
forall (m :: * -> *) context r.
MonadLogger 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
  ()
  ConvertState
  m
  (((intro -> ExampleT context IO [Result])
    -> ExampleT context IO ())
   -> RunNodeFixed context)
-> RWST
     RunTreeContext
     ()
     ConvertState
     m
     ((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
-> RWST
     RunTreeContext
     ()
     ConvertState
     m
     ((intro -> ExampleT context IO [Result]) -> ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
action
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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
     ()
     ConvertState
     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.
MonadLogger 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
  ()
  ConvertState
  m
  ((ExampleT context IO [Result] -> ExampleT context IO ())
   -> RunNodeFixed context)
-> RWST
     RunTreeContext
     ()
     ConvertState
     m
     (ExampleT context IO [Result] -> ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall a b.
RWST RunTreeContext () ConvertState m (a -> b)
-> RWST RunTreeContext () ConvertState m a
-> RWST RunTreeContext () ConvertState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ExampleT context IO [Result] -> ExampleT context IO ())
-> RWST
     RunTreeContext
     ()
     ConvertState
     m
     (ExampleT context IO [Result] -> ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO [Result] -> ExampleT context IO ()
actionWith
specToRunTree' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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 () ConvertState 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.
MonadLogger 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' node :: Free (SpecCommand context IO) r
node@(Free (Parallel'' Maybe SrcLoc
loc NodeOptions
no SpecFree context IO ()
subspec Free (SpecCommand context IO) r
next)) = do
  RunNodeCommonFixed
common <- FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
"Parallel" Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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 () ConvertState 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.
MonadLogger 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' node :: Free (SpecCommand context IO) r
node@(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
-> Free (SpecCommand context IO) r
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
loc Free (SpecCommand context IO) r
node NodeOptions
no
  Free (SpecCommand context IO) r
-> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger 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 () ConvertState 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 () ConvertState m (ExampleT context IO ())
-> RWST RunTreeContext () ConvertState m (RunNodeFixed context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExampleT context IO ()
-> RWST RunTreeContext () ConvertState m (ExampleT context IO ())
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExampleT context IO ()
example
specToRunTree' (Pure r
_) = [RunNodeFixed context] -> ConvertM m [RunNodeFixed context]
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (m :: * -> *) a. Monad m => a -> m a
return []


-- * Util

type ConvertM m = RWST RunTreeContext () ConvertState m

getCommon :: (MonadLogger m) => String -> Maybe SrcLoc -> Free (SpecCommand context n) a -> NodeOptions -> ConvertM m RunNodeCommonFixed
getCommon :: forall (m :: * -> *) context (n :: * -> *) a.
MonadLogger m =>
FilePath
-> Maybe SrcLoc
-> Free (SpecCommand context n) a
-> NodeOptions
-> ConvertM m RunNodeCommonFixed
getCommon FilePath
l Maybe SrcLoc
srcLoc Free (SpecCommand context n) a
node (NodeOptions {Bool
Int
Maybe NodeModuleInfo
nodeOptionsVisibilityThreshold :: Int
nodeOptionsCreateFolder :: Bool
nodeOptionsRecordTime :: Bool
nodeOptionsModuleInfo :: Maybe NodeModuleInfo
nodeOptionsVisibilityThreshold :: NodeOptions -> Int
nodeOptionsCreateFolder :: NodeOptions -> Bool
nodeOptionsRecordTime :: NodeOptions -> Bool
nodeOptionsModuleInfo :: NodeOptions -> Maybe NodeModuleInfo
..}) = do
  RunTreeContext {Maybe (FilePath, Int)
Seq Int
runTreeCurrentAncestors :: RunTreeContext -> Seq Int
runTreeRootFolderAndNumChildren :: RunTreeContext -> Maybe (FilePath, Int)
runTreeCurrentAncestors :: Seq Int
runTreeRootFolderAndNumChildren :: Maybe (FilePath, Int)
..} <- RWST RunTreeContext () ConvertState m RunTreeContext
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
ask

  -- Get a unique ID for this node
  Int
ident <- ConvertState -> Int
_convertStateIdCounter (ConvertState -> Int)
-> RWST RunTreeContext () ConvertState m ConvertState
-> RWST RunTreeContext () ConvertState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RunTreeContext () ConvertState m ConvertState
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
  (ConvertState -> ConvertState)
-> RWST RunTreeContext () ConvertState m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify (ASetter ConvertState ConvertState Int Int
-> (Int -> Int) -> ConvertState -> ConvertState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConvertState ConvertState Int Int
Lens' ConvertState Int
convertStateIdCounter (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))

  -- Determine the folder for the node
  Maybe FilePath
folder <- case Bool
nodeOptionsCreateFolder of
    Bool
False -> Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
    Bool
True -> do
      Map Int CreatedNode
createdNodes <- ConvertState -> Map Int CreatedNode
_convertStateCreatedNodes (ConvertState -> Map Int CreatedNode)
-> RWST RunTreeContext () ConvertState m ConvertState
-> RWST RunTreeContext () ConvertState m (Map Int CreatedNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RunTreeContext () ConvertState m ConvertState
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
      -- Look up the first ancestor that has a folder
      case [(Int, (FilePath, Int, Int))] -> Maybe (Int, (FilePath, Int, Int))
forall a. [a] -> Maybe a
headMay [(Int
ancestor, (FilePath, Int, Int)
folder) | ancestor :: Int
ancestor@((Int -> Map Int CreatedNode -> Maybe CreatedNode)
-> Map Int CreatedNode -> Int -> Maybe CreatedNode
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Map Int CreatedNode -> Maybe CreatedNode
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map Int CreatedNode
createdNodes -> Just (CreatedNode (Just (FilePath, Int, Int)
folder)))
                                         <- (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int]) -> Seq Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Seq Int -> Seq Int
forall a. Seq a -> Seq a
Seq.reverse Seq Int
runTreeCurrentAncestors)] of
        Maybe (Int, (FilePath, Int, Int))
Nothing -> do
          -- No ancestor has a folder, so we have to put this folder under the root
          case Maybe (FilePath, Int)
runTreeRootFolderAndNumChildren of
            Just (FilePath
rootFolder, Int
numRootChildren) -> do
              Int
nextRootChild <- ConvertState -> Int
_convertStateRootNextChildIndex (ConvertState -> Int)
-> RWST RunTreeContext () ConvertState m ConvertState
-> RWST RunTreeContext () ConvertState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RunTreeContext () ConvertState m ConvertState
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
get
              (ConvertState -> ConvertState)
-> RWST RunTreeContext () ConvertState m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify (ASetter ConvertState ConvertState Int Int
-> (Int -> Int) -> ConvertState -> ConvertState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ConvertState ConvertState Int Int
Lens' ConvertState Int
convertStateRootNextChildIndex (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
              Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
 -> RWST RunTreeContext () ConvertState m (Maybe FilePath))
-> Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
rootFolder FilePath -> ShowS
</> FilePath -> Int -> Int -> FilePath
nodeToFolderName FilePath
l Int
numRootChildren Int
nextRootChild)
            Maybe (FilePath, Int)
Nothing -> Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        Just (Int
ancestor, (FilePath
folder, Int
totalChildren, Int
nextChildIndex)) -> do
          let bumpAncestorNextChildIndex :: M.Map Int CreatedNode -> M.Map Int CreatedNode
              bumpAncestorNextChildIndex :: Map Int CreatedNode -> Map Int CreatedNode
bumpAncestorNextChildIndex = (CreatedNode -> CreatedNode)
-> Int -> Map Int CreatedNode -> Map Int CreatedNode
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (ASetter CreatedNode CreatedNode Int Int
-> (Int -> Int) -> CreatedNode -> CreatedNode
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Maybe (FilePath, Int, Int)
 -> Identity (Maybe (FilePath, Int, Int)))
-> CreatedNode -> Identity CreatedNode
Lens' CreatedNode (Maybe (FilePath, Int, Int))
createdNodeFolder ((Maybe (FilePath, Int, Int)
  -> Identity (Maybe (FilePath, Int, Int)))
 -> CreatedNode -> Identity CreatedNode)
-> ((Int -> Identity Int)
    -> Maybe (FilePath, Int, Int)
    -> Identity (Maybe (FilePath, Int, Int)))
-> ASetter CreatedNode CreatedNode Int Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Int, Int) -> Identity (FilePath, Int, Int))
-> Maybe (FilePath, Int, Int)
-> Identity (Maybe (FilePath, Int, Int))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just (((FilePath, Int, Int) -> Identity (FilePath, Int, Int))
 -> Maybe (FilePath, Int, Int)
 -> Identity (Maybe (FilePath, Int, Int)))
-> ((Int -> Identity Int)
    -> (FilePath, Int, Int) -> Identity (FilePath, Int, Int))
-> (Int -> Identity Int)
-> Maybe (FilePath, Int, Int)
-> Identity (Maybe (FilePath, Int, Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int)
-> (FilePath, Int, Int) -> Identity (FilePath, Int, Int)
forall s t a b. Field3 s t a b => Lens s t a b
Lens (FilePath, Int, Int) (FilePath, Int, Int) Int Int
_3) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) Int
ancestor
          (ConvertState -> ConvertState)
-> RWST RunTreeContext () ConvertState m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify (ASetter
  ConvertState
  ConvertState
  (Map Int CreatedNode)
  (Map Int CreatedNode)
-> (Map Int CreatedNode -> Map Int CreatedNode)
-> ConvertState
-> ConvertState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ConvertState
  ConvertState
  (Map Int CreatedNode)
  (Map Int CreatedNode)
Lens' ConvertState (Map Int CreatedNode)
convertStateCreatedNodes Map Int CreatedNode -> Map Int CreatedNode
bumpAncestorNextChildIndex)
          Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a. a -> RWST RunTreeContext () ConvertState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath
 -> RWST RunTreeContext () ConvertState m (Maybe FilePath))
-> Maybe FilePath
-> RWST RunTreeContext () ConvertState m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
folder FilePath -> ShowS
</> FilePath -> Int -> Int -> FilePath
nodeToFolderName FilePath
l Int
totalChildren Int
nextChildIndex)

  -- Insert this node into the ConvertState
  (ConvertState -> ConvertState)
-> RWST RunTreeContext () ConvertState m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
(s -> s) -> RWST r w s m ()
modify ((ConvertState -> ConvertState)
 -> RWST RunTreeContext () ConvertState m ())
-> (ConvertState -> ConvertState)
-> RWST RunTreeContext () ConvertState m ()
forall a b. (a -> b) -> a -> b
$ ASetter
  ConvertState
  ConvertState
  (Map Int CreatedNode)
  (Map Int CreatedNode)
-> (Map Int CreatedNode -> Map Int CreatedNode)
-> ConvertState
-> ConvertState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ConvertState
  ConvertState
  (Map Int CreatedNode)
  (Map Int CreatedNode)
Lens' ConvertState (Map Int CreatedNode)
convertStateCreatedNodes ((Map Int CreatedNode -> Map Int CreatedNode)
 -> ConvertState -> ConvertState)
-> (Map Int CreatedNode -> Map Int CreatedNode)
-> ConvertState
-> ConvertState
forall a b. (a -> b) -> a -> b
$ Int -> CreatedNode -> Map Int CreatedNode -> Map Int CreatedNode
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
ident (CreatedNode -> Map Int CreatedNode -> Map Int CreatedNode)
-> CreatedNode -> Map Int CreatedNode -> Map Int CreatedNode
forall a b. (a -> b) -> a -> b
$ Maybe (FilePath, Int, Int) -> CreatedNode
CreatedNode (Maybe (FilePath, Int, Int) -> CreatedNode)
-> Maybe (FilePath, Int, Int) -> CreatedNode
forall a b. (a -> b) -> a -> b
$ case Maybe FilePath
folder of
    Maybe FilePath
Nothing -> Maybe (FilePath, Int, Int)
forall a. Maybe a
Nothing
    Just FilePath
f -> (FilePath, Int, Int) -> Maybe (FilePath, Int, Int)
forall a. a -> Maybe a
Just (FilePath
f, Free (SpecCommand context n) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countSubspecFolderChildren Free (SpecCommand context n) a
node, Int
0)

  RunNodeCommonFixed -> ConvertM m RunNodeCommonFixed
forall a. a -> RWST RunTreeContext () ConvertState m a
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 {
    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 = Maybe FilePath
folder
    , 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 :: (MonadLogger m) => Free (SpecCommand context IO) r -> RunNodeFixed context -> ConvertM m [RunNodeFixed context]
continueWith :: forall (m :: * -> *) context r.
MonadLogger m =>
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 <- Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) r
next
  [RunNodeFixed context] -> ConvertM m [RunNodeFixed context]
forall a. a -> RWST RunTreeContext () ConvertState m a
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 :: (MonadLogger m) => String -> NodeOptions -> RunNodeCommonFixed -> Free (SpecCommand context IO) r -> ConvertM m [RunNodeFixed context]
recurse :: forall (m :: * -> *) context r.
MonadLogger m =>
FilePath
-> NodeOptions
-> RunNodeCommonFixed
-> Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
recurse FilePath
_ (NodeOptions {}) (RunNodeCommonWithStatus {Bool
Int
FilePath
Maybe FilePath
Maybe SrcLoc
Seq Int
Seq LogEntry
Status
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> FilePath
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 FilePath
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 :: FilePath
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Bool
runTreeOpen :: Bool
runTreeStatus :: Status
runTreeVisible :: Bool
runTreeFolder :: Maybe FilePath
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Seq LogEntry
runTreeLoc :: Maybe SrcLoc
..}) Free (SpecCommand context IO) r
subspec = (RunTreeContext -> RunTreeContext)
-> RWST RunTreeContext () ConvertState m [RunNodeFixed context]
-> RWST RunTreeContext () ConvertState 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 { runTreeCurrentAncestors = runTreeAncestors })
  (Free (SpecCommand context IO) r
-> RWST RunTreeContext () ConvertState m [RunNodeFixed context]
forall (m :: * -> *) context r.
MonadLogger m =>
Free (SpecCommand context IO) r
-> ConvertM m [RunNodeFixed context]
specToRunTree' Free (SpecCommand context IO) r
subspec)