module Test.Sandwich.Interpreters.PrettyShow (prettyShow) where

import Control.Monad.Free
import qualified Data.List as L
import Test.Sandwich.Types.Spec


-- | Pretty show a spec tree
prettyShow :: Free (SpecCommand context m) r -> String
prettyShow :: Free (SpecCommand context m) r -> String
prettyShow = Int -> Free (SpecCommand context m) r -> String
forall context (m :: * -> *) r.
Int -> Free (SpecCommand context m) r -> String
prettyShow' Int
0

prettyShow' :: Int -> Free (SpecCommand context m) r -> String
prettyShow' :: Int -> Free (SpecCommand context m) r -> String
prettyShow' Int
indent (Free (Before'' Maybe SrcLoc
_loc NodeOptions
_no String
l ExampleT context m ()
_f SpecFree context m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree context m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree context m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (After'' Maybe SrcLoc
_loc NodeOptions
_no String
l ExampleT context m ()
_f SpecFree context m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree context m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree context m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (Introduce'' Maybe SrcLoc
_loc NodeOptions
_no String
l Label l intro
_cl ExampleT context m intro
_alloc intro -> ExampleT context m ()
_cleanup SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree (LabelValue l intro :> context) m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (IntroduceWith'' Maybe SrcLoc
_loc NodeOptions
_no String
l Label l intro
_cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
_action SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree (LabelValue l intro :> context) m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (Around'' Maybe SrcLoc
_loc NodeOptions
_no String
l ExampleT context m [Result] -> ExampleT context m ()
_f SpecFree context m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree context m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree context m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (Describe'' Maybe SrcLoc
_loc NodeOptions
_no String
l SpecFree context m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree context m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l SpecFree context m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (Parallel'' Maybe SrcLoc
_loc NodeOptions
_no SpecFree context m ()
subspec Free (SpecCommand context m) r
next)) = Int
-> String
-> SpecFree context m ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
"parallel" SpecFree context m ()
subspec Free (SpecCommand context m) r
next
prettyShow' Int
indent (Free (It'' Maybe SrcLoc
_loc NodeOptions
_no String
l ExampleT context m ()
_ex Free (SpecCommand context m) r
next)) = Int
-> String
-> Free (SpecCommand () m) ()
-> Free (SpecCommand context m) r
-> String
forall c (m :: * -> *) r c' r'.
Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
l ((() -> Free (SpecCommand () m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) :: Free (SpecCommand () m) ()) Free (SpecCommand context m) r
next
prettyShow' Int
_ (Pure r
_) = String
""

-- * Util

indentSize :: Int
indentSize :: Int
indentSize = Int
2

showNode :: Int -> String -> Free (SpecCommand c m) r -> Free (SpecCommand c' m) r' -> String
showNode :: Int
-> String
-> Free (SpecCommand c m) r
-> Free (SpecCommand c' m) r'
-> String
showNode Int
indent String
label Free (SpecCommand c m) r
subspec Free (SpecCommand c' m) r'
next = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") [
  (Int -> Char -> String
forall a. Int -> a -> [a]
L.replicate Int
indent Char
' ') String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
label
  , Int -> Free (SpecCommand c m) r -> String
forall context (m :: * -> *) r.
Int -> Free (SpecCommand context m) r -> String
prettyShow' (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentSize) Free (SpecCommand c m) r
subspec
  , Int -> Free (SpecCommand c' m) r' -> String
forall context (m :: * -> *) r.
Int -> Free (SpecCommand context m) r -> String
prettyShow' Int
indent Free (SpecCommand c' m) r'
next
  ]