Evaluate test tag expressions

4 files changed, 10 insertions, 4 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 3285bee..619c4a5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -193,7 +193,7 @@ main = do
             | otherwise       = OutputStyleQuiet
     out <- startOutput outputStyle useColor
 
-    ( modules, globalDefs ) <- loadModules (map fst files)
+    ( modules, _, globalDefs ) <- loadModules (map fst files)
     tests <- filter ((`notElem` optExclude opts) . testName) <$> if null otests
         then fmap concat $ forM (zip modules files) $ \( Module {..}, ( filePath, mbTestName )) -> do
             case mbTestName of
diff --git a/src/Run.hs b/src/Run.hs
index b8ab186..d8251a2 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -142,7 +142,7 @@ runTest out opts gdefs test = do
             return False
 
 
-loadModules :: [ FilePath ] -> IO ( [ Module ], GlobalDefs )
+loadModules :: [ FilePath ] -> IO ( [ Module ], [ ( ( ModuleName, Text ), [ Tag ] ) ], GlobalDefs )
 loadModules files = do
     ( modules, allModules ) <- parseTestFiles files >>= \case
         Right res -> do
@@ -155,7 +155,9 @@ loadModules files = do
                     putStrLn (showErrorComponent err)
             exitFailure
     let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules
-    return ( modules, globalDefs )
+        evalTags test = map (\e -> runSimpleEval (eval e) globalDefs []) $ testTags test
+        tags = concatMap (\Module {..} -> map (\test -> ( ( moduleName, testName test ), evalTags test )) moduleTests) modules
+    return ( modules, tags, globalDefs )
 
 
 evalGlobalDefs :: [ (( ModuleName, VarName ), SomeExpr ) ] -> GlobalDefs
diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs
index bff363c..09b7c80 100644
--- a/src/Script/Expr.hs
+++ b/src/Script/Expr.hs
@@ -4,6 +4,7 @@ module Script.Expr (
     MonadEval(..), VariableDictionary, GlobalDefs,
     lookupVar, tryLookupVar, withVar, withTypedVar,
     eval, evalSome, evalSomeWith,
+    runSimpleEval,
 
     FunctionType, DynamicType,
     ExprType(..), SomeExpr(..),
diff --git a/src/TestMode.hs b/src/TestMode.hs
index 33f2493..d2cf00d 100644
--- a/src/TestMode.hs
+++ b/src/TestMode.hs
@@ -38,6 +38,7 @@ data TestModeInput = TestModeInput
 
 data TestModeState = TestModeState
     { tmsModules :: [ Module ]
+    , tmsTags :: [ ( ( ModuleName, Text ), [ Tag ] ) ]
     , tmsGlobals :: GlobalDefs
     , tmsNextTestNumber :: Int
     }
@@ -45,6 +46,7 @@ data TestModeState = TestModeState
 initTestModeState :: TestModeState
 initTestModeState = TestModeState
     { tmsModules = mempty
+    , tmsTags = mempty
     , tmsGlobals = mempty
     , tmsNextTestNumber = 1
     }
@@ -147,9 +149,10 @@ cmdLoad = do
 cmdLoadConfig :: Command
 cmdLoadConfig = do
     Just config <- asks tmiConfig
-    ( modules, globalDefs ) <- liftIO $ loadModules =<< getConfigTestFiles config
+    ( modules, tags, globalDefs ) <- liftIO $ loadModules =<< getConfigTestFiles config
     modify $ \s -> s
         { tmsModules = modules
+        , tmsTags = tags
         , tmsGlobals = globalDefs
         }
     cmdOut "load-config-done"