-- | Filter a spec tree to match a module

module Test.Sandwich.Interpreters.FilterTreeModule (filterTreeToModule) where

import Control.Monad.Free
import Test.Sandwich.Types.Spec


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


matches :: NodeOptions -> String -> Bool
matches :: NodeOptions -> String -> Bool
matches (NodeOptions {nodeOptionsModuleInfo :: NodeOptions -> Maybe NodeModuleInfo
nodeOptionsModuleInfo=(Just (NodeModuleInfo {String
Maybe (IO ())
nodeModuleInfoFn :: NodeModuleInfo -> Maybe (IO ())
nodeModuleInfoModuleName :: NodeModuleInfo -> String
nodeModuleInfoFn :: Maybe (IO ())
nodeModuleInfoModuleName :: String
..}))}) String
match = String
nodeModuleInfoModuleName forall a. Eq a => a -> a -> Bool
== String
match
matches NodeOptions
_ String
_ = Bool
False