diff options
| -rw-r--r-- | src/Parser.hs | 13 | ||||
| -rw-r--r-- | src/Test.hs | 7 |
2 files changed, 19 insertions, 1 deletions
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 |