module Test.Sandwich.Internal.Inspection where

import Control.Monad
import Control.Monad.Logger
import Data.Function
import qualified Data.List as L
import Data.String.Interpolate
import Test.Sandwich.Internal.Running
import Test.Sandwich.Interpreters.FilterTree
import Test.Sandwich.Interpreters.PruneTree
import Test.Sandwich.Interpreters.RunTree
import Test.Sandwich.Types.RunTree


getRunTree :: Options -> CoreSpec -> IO [RunNodeFixed BaseContext]
getRunTree :: Options -> CoreSpec -> IO [RunNodeFixed BaseContext]
getRunTree Options
options CoreSpec
spec = do
  BaseContext
baseContext' <- Options -> IO BaseContext
baseContextFromOptions Options
options
  let baseContext :: BaseContext
baseContext = BaseContext
baseContext' { baseContextPath = Just "/path", baseContextRunRoot = Just "/root" }
  LoggingT IO [RunNodeFixed BaseContext]
-> IO [RunNodeFixed BaseContext]
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStderrLoggingT (LoggingT IO [RunNodeFixed BaseContext]
 -> IO [RunNodeFixed BaseContext])
-> LoggingT IO [RunNodeFixed BaseContext]
-> IO [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ BaseContext
-> Options -> CoreSpec -> LoggingT IO [RunNodeFixed BaseContext]
forall (m :: * -> *).
MonadLogger m =>
BaseContext -> Options -> CoreSpec -> m [RunNodeFixed BaseContext]
getRunTree' BaseContext
baseContext Options
options CoreSpec
spec

getRunTree' :: MonadLogger m => BaseContext -> Options -> CoreSpec -> m [RunNodeFixed BaseContext]
getRunTree' :: forall (m :: * -> *).
MonadLogger m =>
BaseContext -> Options -> CoreSpec -> m [RunNodeFixed BaseContext]
getRunTree' BaseContext
baseContext (Options {optionsPruneTree :: Options -> Maybe TreeFilter
optionsPruneTree=(Maybe TreeFilter -> [FilePath]
unwrapTreeFilter -> [FilePath]
pruneOpts), optionsFilterTree :: Options -> Maybe TreeFilter
optionsFilterTree=(Maybe TreeFilter -> [FilePath]
unwrapTreeFilter -> [FilePath]
filterOpts)}) CoreSpec
spec =
  CoreSpec
spec
    CoreSpec -> (CoreSpec -> CoreSpec) -> CoreSpec
forall a b. a -> (a -> b) -> b
& (\CoreSpec
tree -> (CoreSpec -> FilePath -> CoreSpec)
-> CoreSpec -> [FilePath] -> CoreSpec
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' CoreSpec -> FilePath -> CoreSpec
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> FilePath -> Free (SpecCommand context m) ()
pruneTree CoreSpec
tree [FilePath]
pruneOpts)
    CoreSpec -> (CoreSpec -> CoreSpec) -> CoreSpec
forall a b. a -> (a -> b) -> b
& (\CoreSpec
tree -> (CoreSpec -> FilePath -> CoreSpec)
-> CoreSpec -> [FilePath] -> CoreSpec
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' CoreSpec -> FilePath -> CoreSpec
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> FilePath -> Free (SpecCommand context m) ()
filterTree CoreSpec
tree [FilePath]
filterOpts)
    CoreSpec
-> (CoreSpec -> m [RunNodeFixed BaseContext])
-> m [RunNodeFixed BaseContext]
forall a b. a -> (a -> b) -> b
& BaseContext -> CoreSpec -> m [RunNodeFixed BaseContext]
forall (m :: * -> *).
MonadLogger m =>
BaseContext -> CoreSpec -> m [RunNodeFixed BaseContext]
specToRunTreeM BaseContext
baseContext

printRunTree :: [RunNodeFixed ctx] -> IO ()
printRunTree :: forall ctx. [RunNodeFixed ctx] -> IO ()
printRunTree = Int -> [RunNodeFixed ctx] -> IO ()
forall ctx. Int -> [RunNodeFixed ctx] -> IO ()
go Int
0
  where
    go :: Int -> [RunNodeFixed ctx] -> IO ()
    go :: forall ctx. Int -> [RunNodeFixed ctx] -> IO ()
go Int
depth [RunNodeFixed ctx]
nodes = do
      [RunNodeFixed ctx] -> (RunNodeFixed ctx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RunNodeFixed ctx]
nodes ((RunNodeFixed ctx -> IO ()) -> IO ())
-> (RunNodeFixed ctx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \node :: RunNodeFixed ctx
node@(RunNodeFixed ctx
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon -> RunNodeCommonWithStatus {Bool
Int
FilePath
Maybe FilePath
Maybe SrcLoc
Seq Int
Seq LogEntry
Status
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
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
..}) -> do
        let spaces :: FilePath
spaces = Int -> Char -> FilePath
forall a. Int -> a -> [a]
L.replicate (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
        FilePath -> IO ()
putStrLn [i|#{spaces}#{runTreeLabel}, \##{runTreeId} with ancestors #{runTreeAncestors}. Folder: #{runTreeFolder}|]

        case RunNodeFixed ctx
node of
          RunNodeIntroduce {[RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
ExampleT ctx IO intro
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
intro -> ExampleT ctx IO ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
runNodeAlloc :: ExampleT ctx IO intro
runNodeCleanup :: intro -> ExampleT ctx IO ()
runNodeChildrenAugmented :: ()
runNodeAlloc :: ()
runNodeCleanup :: ()
..} -> Int
-> [RunNodeWithStatus
      (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
-> IO ()
forall ctx. Int -> [RunNodeFixed ctx] -> IO ()
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
          RunNodeIntroduceWith {[RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
(intro -> ExampleT ctx IO [Result]) -> ExampleT ctx IO ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeChildrenAugmented :: ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
runNodeIntroduceAction :: (intro -> ExampleT ctx IO [Result]) -> ExampleT ctx IO ()
runNodeIntroduceAction :: ()
..} -> Int
-> [RunNodeWithStatus
      (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
-> IO ()
forall ctx. Int -> [RunNodeFixed ctx] -> IO ()
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [RunNodeWithStatus
   (LabelValue lab intro :> ctx) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
          RunNodeIt {} -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          RunNodeFixed ctx
_ -> Int -> [RunNodeFixed ctx] -> IO ()
forall ctx. Int -> [RunNodeFixed ctx] -> IO ()
go (Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (RunNodeFixed ctx -> [RunNodeFixed ctx]
forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeFixed ctx
node)