allow fake "Eventually" temporal constraint

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

Hide file tree

Showing 4 changed files with 11 additions and 15 deletions.
diff --git a/mengwong/mp/src/BasicTypes.hs b/mengwong/mp/src/BasicTypes.hs
@@ -20,7 +20,7 @@ data MyStream = MyStream
 
 data MyToken = Every | Party | Who | Means | When | Is | Always
              | Must | May | Shant | If | Or | And
-             | Before | After | By | On
+             | Before | After | By | On | Eventually
              | Unless
              | Hence | Lest
              | Number Int

diff --git a/mengwong/mp/src/Error.hs b/mengwong/mp/src/Error.hs
@@ -21,12 +21,6 @@ import Data.Vector (imap, foldl')
 import qualified Data.Text.Lazy as Text
 import Control.Arrow ((>>>))
 
-data Custom = MyCustom String
-  deriving (Eq, Show, Ord)
-
-instance ShowErrorComponent Custom where
-  showErrorComponent (MyCustom str) = str
-
 -- custom version of https://hackage.haskell.org/package/megaparsec-9.2.0/docs/src/Text.Megaparsec.Error.html#errorBundlePretty
 errorBundlePrettyCustom ::
   forall e .

diff --git a/mengwong/mp/src/Lib.hs b/mengwong/mp/src/Lib.hs
@@ -415,9 +415,9 @@ mergePBRS xs =
      -- trace ("mergePBRS: about to return " ++ show toreturn)
      toreturn
 
-pTemporal :: Parser (TemporalConstraint Text.Text)
+pTemporal :: Parser (Maybe (TemporalConstraint Text.Text))
 pTemporal = do
-  t1 <- pToken Before <|> pToken After <|> pToken By
+  t1 <- pToken Before <|> pToken After <|> pToken By <|> pToken Eventually
   t2 <- pOtherVal                                    <* dnl
   return $ mkTC t1 t2
 
@@ -455,7 +455,7 @@ permutations whoifwhen = debugName ("permutations" <> show whoifwhen) $ do
             <$$> pAction
             <|?> ([], some $ preambleBoolRules whoifwhen) -- syntactic constraint, all the if/when need to be contiguous.
             <||> pDeontic <* optional dnl
-            <|?> (Nothing , Just <$> pTemporal )
+            <|?> (Nothing , pTemporal )
           )
 
 newPre :: Text.Text -> AA.Item Text.Text -> AA.Item Text.Text

diff --git a/mengwong/mp/src/Types.hs b/mengwong/mp/src/Types.hs
@@ -52,11 +52,12 @@ type BoolStruct = AA.Item Text.Text
 data Deontic = DMust | DMay | DShant
   deriving (Eq, Show)
 
-mkTC :: MyToken -> Text.Text -> TemporalConstraint Text.Text
-mkTC Before tt = TBefore tt
-mkTC After  tt = TAfter  tt
-mkTC By     tt = TBy     tt
-mkTC On     tt = TOn     tt
+mkTC :: MyToken -> Text.Text -> Maybe (TemporalConstraint Text.Text)
+mkTC Before     tt = Just $ TBefore tt
+mkTC After      tt = Just $ TAfter  tt
+mkTC By         tt = Just $ TBy     tt
+mkTC On         tt = Just $ TOn     tt
+mkTC Eventually _  = Nothing
 mkTC x      y  = error $ "mkTC: can't create temporal constraint from " ++ show x ++ ", " ++ show y
 
 data RunConfig = RC { debug     :: Bool
@@ -101,6 +102,7 @@ toToken "BEFORE" = Before
 toToken "AFTER" =  After
 toToken "BY" =  By
 toToken "ON" =  On
+toToken "EVENTUALLY" = Eventually
 
 -- the rest of the regulative rule
 toToken "➔"       =     Do