i have broken everything trying to expand the syntax

smucclaw · Oct 20, 2021 · 8acaf89 · 8acaf89
1 parent 58b13c4
commit 8acaf89
Show file tree

Hide file tree

Showing 6 changed files with 95 additions and 29 deletions.
diff --git a/mengwong/mp/src/Lib.hs b/mengwong/mp/src/Lib.hs
@@ -417,11 +417,11 @@ mergePBRS xs =
 
 pTemporal :: Parser (Maybe (TemporalConstraint Text.Text))
 pTemporal = ( do
-                t0 <- pToken Eventually <* dnl
+                t0 <- pToken Eventually
                 return (mkTC t0 "")
             ) <|> do
   t1 <- pToken Before <|> pToken After <|> pToken By
-  t2 <- pOtherVal                                    <* dnl
+  t2 <- pOtherVal
   return $ mkTC t1 t2
 
 -- "PARTY Seller"
@@ -431,9 +431,12 @@ pActor party = do
   entitytype         <- pToken party *> pOtherVal <* dnl
   return (party, entitytype)
 
+pDoAction ::  Parser ActionType
+pDoAction = pToken Do >> pAction
+
 pAction ::  Parser ActionType
 pAction = do
-  action <- pToken Do *> pOtherVal          <* dnl
+  action <- pOtherVal       <* dnl
   params <- many (pOtherVal <* dnl)
   return (action, list2tuples params)
   where
@@ -452,14 +455,44 @@ data RuleBody = RuleBody { rbaction   :: ActionType -- pay(to=Seller, amount=$10
                          }
                       deriving (Eq, Show, Generic)
 
+mkRBfromDT :: ActionType -> [(Preamble, BoolRules)] -> (Deontic, Maybe (TemporalConstraint Text.Text)) -> RuleBody
+mkRBfromDT rba rbpb (rbd,rbt) = RuleBody rba rbpb rbd rbt
+
+mkRBfromDA :: (Deontic, ActionType) -> [(Preamble, BoolRules)] -> Maybe (TemporalConstraint Text.Text) -> RuleBody
+mkRBfromDA (rbd,rba) rbpb rbt = RuleBody rba rbpb rbd rbt
+
 permutations :: [MyToken] -> Parser RuleBody
-permutations whoifwhen = debugName ("permutations" <> show whoifwhen) $ do
-  permute ( RuleBody
-            <$$> pAction
+permutations whoifwhen = debugName ("permutations " <> show whoifwhen) $ do
+  try ( permute ( mkRBfromDT
+            <$$> pDoAction
+            <|?> ([], some $ preambleBoolRules whoifwhen) -- syntactic constraint, all the if/when need to be contiguous.
+            <||> try pDT
+          ) )
+  <|>
+  try ( permute ( mkRBfromDA
+            <$$> try pDA
             <|?> ([], some $ preambleBoolRules whoifwhen) -- syntactic constraint, all the if/when need to be contiguous.
-            <||> pDeontic <* optional dnl
-            <|?> (Nothing , pTemporal )
-          )
+            <||> pTemporal
+          ) )
+
+
+-- the Deontic/temporal/action form
+-- MAY EVENTUALLY
+--  -> pay
+pDT :: Parser (Deontic, Maybe (TemporalConstraint Text.Text))
+pDT = do
+  pd <- pDeontic
+  pt <- optional pTemporal <* dnl
+  return (pd, fromMaybe Nothing pt)
+
+-- the Deontic/Action/Temporal form
+pDA :: Parser (Deontic, ActionType)
+pDA = do
+  pd <- pDeontic
+  pa <- pAction
+  return (pd, pa)
+
+
 
 newPre :: Text.Text -> AA.Item Text.Text -> AA.Item Text.Text
 newPre _ (AA.Leaf x) = AA.Leaf x

diff --git a/mengwong/mp/test/README.org b/mengwong/mp/test/README.org
@@ -317,19 +317,17 @@ Let's not support this case 4 until we have a more principled approach to meta-r
 :TABLE_EXPORT_FORMAT: orgtbl-to-csv
 :END:
 
-| EVERY | person          |        |        |
-| WHO   | walks           |        |        |
-| AND   | eats            |        |        |
-| MUST  |                 |        |        |
-| IF    | the King wishes |        |        |
-| ->    | sing            |        |        |
-| HENCE | PARTY           | King   |        |
-|       | MAY             |        |        |
-|       | AFTER           | 20min  |        |
-|       | ->              | pay    |        |
-| LEST  | Singer          | MUST   |        |
-|       |                 | BEFORE | supper |
-|       |                 | ->     | pay    |
+| EVERY | person          |       |        |        |
+| WHO   | walks           |       |        |        |
+| AND   | eats            |       |        |        |
+| MUST  |                 |       |        |        |
+| IF    | the King wishes |       |        |        |
+| ->    | sing            |       |        |        |
+| HENCE | PARTY           | King  |        |        |
+|       | MAY             | pay   |        |        |
+|       | AFTER           | 20min |        |        |
+| LEST  | Singer          | MUST  | BEFORE | supper |
+|       |                 | ->    | pay    |        |
 
 *** do the individual components work?
 
@@ -352,9 +350,9 @@ do the individual components work?
 :TABLE_EXPORT_FORMAT: orgtbl-to-csv
 :END:
 
-| Singer | MUST   |     |
-| BEFORE | supper |     |
-|        | ->     | pay |
+| Singer | MUST   |        |     |
+|        | BEFORE | supper |     |
+|        |        | ->     | pay |
 
 ** chained regulatives with action params
 :PROPERTIES:
@@ -369,14 +367,35 @@ do the individual components work?
 | IF    | the King wishes |            |            |          |
 | ->    | sing            |            |            |          |
 | HENCE | PARTY           | King       |            |          |
-|       | MAY             | after      | 20min      |          |
+|       | MAY             | AFTER      | 20min      |          |
 |       | ->              | pay        |            |          |
 |       |                 | to         | the Singer |          |
 |       |                 | amount     | $10        |          |
-| LEST  | Singer          | MUST       | before     | supper   |
+| LEST  | Singer          | MUST       | BEFORE     | supper   |
 |       |                 | ->         | pay        |          |
 |       |                 |            | to         | the King |
 |       |                 |            | amount     | $20      |
+** Alternative Arrangements of Temporals and Actions
+*** may pay after time
+:PROPERTIES:
+:TABLE_EXPORT_FILE: chained-regulatives-part1-alternative-1.csv
+:TABLE_EXPORT_FORMAT: orgtbl-to-csv
+:END:
+
+| PARTY | King  |
+| MAY   | pay   |
+| AFTER | 20min |
+
+*** may after time pay
+:PROPERTIES:
+:TABLE_EXPORT_FILE: chained-regulatives-part1-alternative-2.csv
+:TABLE_EXPORT_FORMAT: orgtbl-to-csv
+:END:
+
+| PARTY | King  |       |
+| MAY   | AFTER | 20min |
+| ->    | pay   |       |
+
 ** simple natural language aliases
 :PROPERTIES:
 :TABLE_EXPORT_FILE: nl-aliases.csv

diff --git a/mengwong/mp/test/Spec.hs b/mengwong/mp/test/Spec.hs
@@ -211,6 +211,14 @@ main = do
         mycsv <- BS.readFile "test/chained-regulatives.csv"
         parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` singer_chain
 
+      it "should parse alternative deadline/action arrangement 1" $ do
+        mycsv <- BS.readFile "test/chained-regulatives-part1-alternative-1.csv"
+        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` king_pays_singer
+
+      it "should parse alternative deadline/action arrangement 2" $ do
+        mycsv <- BS.readFile "test/chained-regulatives-part1-alternative-2.csv"
+        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` king_pays_singer
+
   -- upgrade single OR group to bypass the top level AND group
 
 
diff --git a/mengwong/mp/test/chained-regulatives-part1-alternative-1.csv b/mengwong/mp/test/chained-regulatives-part1-alternative-1.csv
@@ -0,0 +1,3 @@
+PARTY,King
+MAY,pay
+AFTER,20min
diff --git a/mengwong/mp/test/chained-regulatives-part1-alternative-2.csv b/mengwong/mp/test/chained-regulatives-part1-alternative-2.csv
@@ -0,0 +1,3 @@
+PARTY,King,
+MAY,AFTER,20min
+->,pay,
diff --git a/mengwong/mp/test/chained-regulatives.csv b/mengwong/mp/test/chained-regulatives.csv
@@ -5,7 +5,7 @@ MUST,,,,
 IF,the King wishes,,,
 ->,sing,,,
 HENCE,PARTY,King,,
-,MAY,AFTER,20min,
-,->,pay,,
+,MAY,pay,,
+,AFTER,20min,,
 LEST,Singer,MUST,BEFORE,supper
 ,,->,pay,