-- | Prunes any nodes and their children in a spec tree that match any of a list of names

module Test.Sandwich.Interpreters.PruneTree (pruneTree) where

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

pruneTree :: Free (SpecCommand context m) () -> String -> Free (SpecCommand context m) ()
pruneTree :: forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> String -> Free (SpecCommand context m) ()
pruneTree Free (SpecCommand context m) ()
tree String
pruneLabel = forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
tree
  where
    go :: Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
    go :: forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go = \case
      (Free (It'' Maybe SrcLoc
loc NodeOptions
no String
label' ExampleT context m ()
ex Free (SpecCommand context m) ()
next))
        | String
label' String -> String -> Bool
`doesNotMatch` String
pruneLabel -> forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> next
-> SpecCommand context m next
It'' Maybe SrcLoc
loc NodeOptions
no String
label' ExampleT context m ()
ex (forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next))
        | Bool
otherwise -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next
      (Free (Introduce'' Maybe SrcLoc
loc NodeOptions
no String
label' 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) ()
next))
        | String
label' String -> String -> Bool
`doesNotMatch` String
pruneLabel ->
          case forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go SpecFree (LabelValue l intro :> context) m ()
subspec of
            (Pure ()
_) -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next
            SpecFree (LabelValue l intro :> context) m ()
subspec' -> forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (forall intro (l :: Symbol) context (m :: * -> *) next.
Typeable intro =>
Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> next
-> SpecCommand context m next
Introduce'' Maybe SrcLoc
loc NodeOptions
no String
label' Label l intro
cl ExampleT context m intro
alloc intro -> ExampleT context m ()
cleanup SpecFree (LabelValue l intro :> context) m ()
subspec' (forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next))
        | Bool
otherwise -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next

      (Free (IntroduceWith'' Maybe SrcLoc
loc NodeOptions
no String
label' Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) ()
next))
        | String
label' String -> String -> Bool
`doesNotMatch` String
pruneLabel ->
          case forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go SpecFree (LabelValue l intro :> context) m ()
subspec of
            (Pure ()
_) -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next
            SpecFree (LabelValue l intro :> context) m ()
subspec' -> forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (forall (l :: Symbol) intro context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ((intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> next
-> SpecCommand context m next
IntroduceWith'' Maybe SrcLoc
loc NodeOptions
no String
label' Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
subspec' (forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next))
        | Bool
otherwise -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next
      (Free (Parallel'' Maybe SrcLoc
loc NodeOptions
no Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) ->
        case forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
subspec of
          (Pure ()
_) -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next
          Free (SpecCommand context m) ()
subspec' -> forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> SpecFree context m ()
-> next
-> SpecCommand context m next
Parallel'' Maybe SrcLoc
loc NodeOptions
no Free (SpecCommand context m) ()
subspec' (forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go Free (SpecCommand context m) ()
next))
      -- Before'', After'', Around'', Describe''
      (Free SpecCommand context m (Free (SpecCommand context m) ())
x)
        | forall context (m :: * -> *) next.
SpecCommand context m next -> String
label SpecCommand context m (Free (SpecCommand context m) ())
x String -> String -> Bool
`doesNotMatch` String
pruneLabel ->
          case forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go (forall context (m :: * -> *) next.
SpecCommand context m next -> SpecFree context m ()
subspec SpecCommand context m (Free (SpecCommand context m) ())
x) of
            (Pure ()
_) -> forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) ())
x)
            Free (SpecCommand context m) ()
subspec' -> forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (SpecCommand context m (Free (SpecCommand context m) ())
x { subspec :: Free (SpecCommand context m) ()
subspec = Free (SpecCommand context m) ()
subspec', next :: Free (SpecCommand context m) ()
next = forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) ())
x) })
        | Bool
otherwise ->
          forall context (m :: * -> *).
Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
go (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) ())
x)
      pureM :: Free (SpecCommand context m) ()
pureM@(Pure ()
_) -> Free (SpecCommand context m) ()
pureM

doesNotMatch :: String -> String -> Bool
doesNotMatch :: String -> String -> Bool
doesNotMatch String
label String
match = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String
match forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
label