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


matches :: String -> String -> Bool
matches :: String -> String -> Bool
matches String
l String
match = String
match String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` String
l