Guard command

1 files changed, 40 insertions, 2 deletions

diff --git a/src/Parser.hs b/src/Parser.hs
index 0608ccd..fa85f8c 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -92,15 +92,20 @@ identifier :: TestParser Text
 identifier = do
     TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_')
 
+varName :: TestParser VarName
+varName = do
+    VarName . T.splitOn (T.singleton '.') . TL.toStrict <$>
+        takeWhile1P Nothing (\x -> isAlphaNum x || x == '_' || x == '.')
+
 varExpansion :: TestParser VarName
 varExpansion = do
     void $ char '$'
     choice
         [ VarName . (:[]) <$> identifier
         ,do void $ char '{'
-            name <- takeWhile1P Nothing (/='}')
+            name <- varName
             void $ char '}'
-            return $ VarName $ T.splitOn (T.singleton '.') (TL.toStrict name)
+            return name
         ]
 
 quotedString :: TestParser (Expr Text)
@@ -143,6 +148,24 @@ regex = label "regular expression" $ lexeme $ do
     _ <- eval expr -- test regex parsing with empty variables
     return expr
 
+stringExpr :: TestParser (Expr Text)
+stringExpr = choice
+    [ quotedString
+    , StringVar <$> varName
+    ]
+
+boolExpr :: TestParser (Expr Bool)
+boolExpr = do
+    x <- stringExpr
+    sc
+    op <- choice
+        [ symbol "==" >> return (==)
+        , symbol "/=" >> return (/=)
+        ]
+    y <- stringExpr
+    sc
+    return $ BinOp op x y
+
 
 class GInit f where ginit :: f x
 instance GInit U1 where ginit = U1
@@ -247,6 +270,20 @@ testExpect = command "expect"
         <*> (maybe (return []) return $ b ^. expectBuilderCaptures)
 
 
+data GuardBuilder = GuardBuilder
+    { _guardBuilderExpr :: Maybe (Expr Bool)
+    }
+    deriving (Generic)
+
+makeLenses ''GuardBuilder
+
+testGuard :: TestParser [TestStep]
+testGuard = command "guard"
+    [ Param "" guardBuilderExpr boolExpr
+    ] $ \s b -> Guard s
+        <$> (maybe (fail "missing guard expression") return $ b ^. guardBuilderExpr)
+
+
 testWait :: TestParser [TestStep]
 testWait = do
     wsymbol "wait"
@@ -258,6 +295,7 @@ parseTestDefinition = label "test definition" $ toplevel $ do
         [ testSpawn
         , testSend
         , testExpect
+        , testGuard
         , testWait
         ]
     where header = do