-- | Filter a spec tree using a string match

module Test.Sandwich.Interpreters.FilterTree (filterTree) where

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

filterTree :: [String] -> Free (SpecCommand context m) () -> Free (SpecCommand context m) ()
filterTree :: forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (Free (It'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
ex Free (SpecCommand context m) ()
next))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
l) [String]
matches = 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
l ExampleT context m ()
ex (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
  | Bool
otherwise = forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next)
filterTree [String]
matches (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) ()
next))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
l) [String]
matches = 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
l Label l intro
cl ExampleT context m intro
alloc intro -> ExampleT context m ()
cleanup SpecFree (LabelValue l intro :> context) m ()
subspec (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
  | Bool
otherwise = case forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches SpecFree (LabelValue l intro :> context) m ()
subspec of
      (Pure ()
_) -> forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next
      SpecFree (LabelValue l intro :> context) m ()
x -> 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
l Label l intro
cl ExampleT context m intro
alloc intro -> ExampleT context m ()
cleanup SpecFree (LabelValue l intro :> context) m ()
x (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
filterTree [String]
matches (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) ()
next))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
l) [String]
matches = 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
l Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
subspec (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
  | Bool
otherwise = case forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches SpecFree (LabelValue l intro :> context) m ()
subspec of
      (Pure ()
_) -> forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next
      SpecFree (LabelValue l intro :> context) m ()
x -> 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
l Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
x (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
filterTree [String]
matches (Free (Parallel'' Maybe SrcLoc
loc NodeOptions
no Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) =
  case forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
subspec of
    (Pure ()
_) -> forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next
    Free (SpecCommand context m) ()
x -> 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) ()
x (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches Free (SpecCommand context m) ()
next))
filterTree [String]
matches (Free SpecCommand context m (Free (SpecCommand context m) ())
x)
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` forall context (m :: * -> *) next.
SpecCommand context m next -> String
label SpecCommand context m (Free (SpecCommand context m) ())
x) [String]
matches = forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (SpecCommand context m (Free (SpecCommand context m) ())
x { next :: Free (SpecCommand context m) ()
next = (forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) ())
x)) })
  | Bool
otherwise = case forall context (m :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (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 :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (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 :: * -> *).
[String]
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTree [String]
matches (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) ())
x)) })
filterTree [String]
_ (Pure ()
x) = forall (f :: * -> *) a. a -> Free f a
Pure ()
x