{-# 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

-- | Convert a spec to a run tree
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 []


-- * Util

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

  -- Get a unique ID for this node
  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)