improve handling of EVENTUALLY; add test

smucclaw · Oct 19, 2021 · b3c6732 · b3c6732
1 parent 5489bb8
commit b3c6732
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 2 deletions.
diff --git a/mengwong/mp/src/Lib.hs b/mengwong/mp/src/Lib.hs
@@ -416,8 +416,11 @@ mergePBRS xs =
      toreturn
 
 pTemporal :: Parser (Maybe (TemporalConstraint Text.Text))
-pTemporal = do
-  t1 <- pToken Before <|> pToken After <|> pToken By <|> pToken Eventually
+pTemporal = ( do
+                t0 <- pToken Eventually <* dnl
+                return (mkTC t0 "")
+            ) <|> do
+  t1 <- pToken Before <|> pToken After <|> pToken By
   t2 <- pOtherVal                                    <* dnl
   return $ mkTC t1 t2
 

diff --git a/mengwong/mp/test/Spec.hs b/mengwong/mp/test/Spec.hs
@@ -37,6 +37,7 @@ r `shouldParse` v = case r of
         ++ errorBundlePrettyCustom e
   Right x -> x `shouldBe` v
 
+defaultReg :: Rule
 defaultReg = Regulative
   { every = "person"
   , who = Nothing
@@ -72,6 +73,10 @@ main = do
         parseR (pRule <* eof) "" (exampleStream ",,,,\n,EVERY,person,,\n,WHO,walks,,\n,MUST,,,\n,->,sing,,\n")
           `shouldParse` [ defaultReg { who = Just (Leaf "walks") } ]
 
+      it "should parse the null temporal EVENTUALLY" $ do
+        parseR (pRule <* eof) "" (exampleStream ",,,,\n,EVERY,person,,\n,WHO,walks,,\n,MUST,EVENTUALLY,,\n,->,sing,,\n")
+          `shouldParse` [ defaultReg { who = Just (Leaf "walks") } ]
+
       it "should parse dummySing" $ do
         parseR (pRule <* eof) "" (exampleStream ",,,,\n,EVERY,person,,\n,WHO,walks,// comment,continued comment should be ignored\n,AND,runs,,\n,AND,eats,,\n,OR,drinks,,\n,MUST,,,\n,->,sing,,\n")
           `shouldParse` [ defaultReg {