From 204169f26907828d5310845a94af7c4ffafa6cd0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 11 Apr 2026 16:11:58 +0200
Subject: Tag definition

---
 src/Parser.hs | 13 ++++++++++++-
 src/Test.hs   |  7 +++++++
 2 files changed, 19 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/Parser.hs b/src/Parser.hs
index 9f1a0e3..d3b8f73 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -125,13 +125,23 @@ parseAsset href = label "asset definition" $ do
     modify $ \s -> s { testVars = ( name, ( GlobalVarName (testCurrentModuleName s) name, someExprType expr )) : testVars s }
     return ( name, expr )
 
+parseTag :: Pos -> TestParser ( VarName, SomeExpr )
+parseTag _ = label "tag definition" $ do
+    wsymbol "tag"
+    name <- constrName
+    void eol
+    cmn <- gets testCurrentModuleName
+    let expr = SomeExpr $ Pure $ Tag cmn name
+    modify $ \s -> s { testVars = ( name, ( GlobalVarName cmn name, someExprType expr )) : testVars s }
+    return ( name, expr )
+
 parseExport :: TestParser [ Toplevel ]
 parseExport = label "export declaration" $ toplevel id $ do
     ref <- L.indentLevel
     wsymbol "export"
     choice
       [ do
-        def@( name, _ ) <- parseDefinition ref <|> parseAsset ref
+        def@( name, _ ) <- parseDefinition ref <|> parseAsset ref <|> parseTag ref
         return [ ToplevelDefinition def, ToplevelExport name ]
       , do
         names <- listOf varName
@@ -168,6 +178,7 @@ parseTestModule absPath = do
         [ (: []) <$> parseTestDefinition
         , (: []) <$> toplevel ToplevelDefinition (parseDefinition pos1)
         , (: []) <$> toplevel ToplevelDefinition (parseAsset pos1)
+        , (: []) <$> toplevel ToplevelDefinition (parseTag pos1)
         , parseExport
         , parseImport
         ]
diff --git a/src/Test.hs b/src/Test.hs
index cfeaa2d..f1d1f96 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,5 +1,6 @@
 module Test (
     Test(..),
+    Tag(..),
     TestStep(..),
     TestBlock(..),
 
@@ -28,6 +29,12 @@ data Test = Test
     , testSteps :: Expr (TestStep ())
     }
 
+data Tag = Tag ModuleName VarName
+
+instance ExprType Tag where
+    textExprType _ = "Tag"
+    textExprValue (Tag mname vname) = "<tag:" <> textModuleName mname <> "." <> textVarName vname <> ">"
+
 data TestBlock a where
     EmptyTestBlock :: TestBlock ()
     TestBlockStep :: TestBlock () -> TestStep a -> TestBlock a
-- 
cgit v1.2.3