chained regulatives are almost working

mengwong/mp/src/Lib.hs

@@ -358,6 +358,7 @@ pRegRuleSugary = do
                  (rbdeon rulebody)
                  (rbaction rulebody)
                  (rbtemporal rulebody)
+                 Nothing Nothing Nothing
   myTraceM $ "pRegRuleSugary: the specifier is " ++ show who
   myTraceM $ "pRegRuleSugary: returning " ++ show toreturn
   myTraceM $ "pRegRuleSugary: with appendix brs = " ++ show brs
@@ -379,6 +380,8 @@ pRegRuleNormal = do
   (_party_every, entitytype)   <- pActor Party <|> pActor Every
   -- (Who, (BoolStruct,[Rule]))
   whoBool                     <- optional (withDepth leftX (preambleBoolRules [Who]))
+  henceLimb                   <- optional $ pHenceLest Hence
+  lestLimb                    <- optional $ pHenceLest Lest
   -- the below are going to be permutables
   myTraceM $ "pRegRuleNormal: preambleBoolRules returned " ++ show whoBool
   rulebody <- permutations [When, If]
@@ -392,11 +395,22 @@ pRegRuleNormal = do
                  (rbdeon rulebody)
                  (rbaction rulebody)
                  (rbtemporal rulebody)
+                 henceLimb
+                 lestLimb
+                 Nothing -- rule label
   myTraceM $ "pRegRuleNormal: the specifier is " ++ show who
   myTraceM $ "pRegRuleNormal: returning " ++ show toreturn
   myTraceM $ "pRegRuleNormal: with appendix brs = " ++ show brs
   return ( toreturn : brs ++ ebrs )
 
+pHenceLest :: MyToken -> Parser [Rule]
+pHenceLest henceLest = do
+  debugPrint "pHenceLest"
+  leftX              <- lookAhead pXLocation -- this is the column where we expect IF/AND/OR etc.
+  checkDepth
+  pToken henceLest
+  withDepth (leftX + 1) pRegRule
+
 mergePBRS :: [(Preamble, BoolRules)] -> (Preamble, BoolRules)
 mergePBRS xs =
   let (w,(a,b)) = head xs

mengwong/mp/src/Types.hs

@@ -28,12 +28,16 @@ data Rule = Regulative
             , deontic  :: Deontic            -- must
             , action   :: ActionType         -- sing
             , temporal :: Maybe (TemporalConstraint Text.Text) -- Before "midnight"
+            , hence    :: Maybe [Rule]
+            , lest     :: Maybe [Rule]
+            , rlabel   :: Maybe Text.Text
             }
           | Constitutive
             { term :: ConstitutiveTerm
             , cond :: Maybe BoolStruct
---            , valu :: Text.Text
             }
+          | RegAlias Text.Text -- softlink to a regulative rule label
+          | ConAlias Text.Text -- softlink to a constitutive rule label
           deriving (Eq, Show)
 -- everything is stringly typed at the moment but as this code matures these will become more specialized.
 data TemporalConstraint a = TBefore a

mengwong/mp/test/README.org

@@ -317,6 +317,47 @@ 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    |        |
+
+*** do the individual components work?
+
+do the individual components work?
+
+**** the king part
+:PROPERTIES:
+:TABLE_EXPORT_FILE: chained-regulatives-part1.csv
+:TABLE_EXPORT_FORMAT: orgtbl-to-csv
+:END:
+
+| PARTY | King  |       |   |
+| MAY   | AFTER | 20min |   |
+| ->    | pay   |       |   |
+
+**** the singer part
+:PROPERTIES:
+:TABLE_EXPORT_FILE: chained-regulatives-part2.csv
+:TABLE_EXPORT_FORMAT: orgtbl-to-csv
+:END:
+
+| Singer | MUST | BEFORE | supper |
+|        | ->   | pay    |        |
+
+** chained regulatives with action params
+:PROPERTIES:
+:TABLE_EXPORT_FILE: chained-regulatives-with-action-params.csv
+:TABLE_EXPORT_FORMAT: orgtbl-to-csv
+:END:
+
 | EVERY | person          |            |            |          |
 | WHO   | walks           |            |            |          |
 | AND   | eats            |            |            |          |
@@ -332,7 +373,6 @@ Let's not support this case 4 until we have a more principled approach to meta-r
 |       |                 | ->         | pay        |          |
 |       |                 |            | to         | the King |
 |       |                 |            | amount     | $20      |
-
 ** simple natural language aliases
 :PROPERTIES:
 :TABLE_EXPORT_FILE: nl-aliases.csv

mengwong/mp/test/Spec.hs

@@ -37,6 +37,18 @@ r `shouldParse` v = case r of
         ++ errorBundlePrettyCustom e
   Right x -> x `shouldBe` v
 
+defaultReg = Regulative
+  { every = "person"
+  , who = Nothing
+  , cond = Nothing
+  , deontic = DMust
+  , action = ("sing",[])
+  , temporal = Nothing
+  , hence = Nothing
+  , lest = Nothing
+  , rlabel = Nothing
+  }
+
 main :: IO ()
 main = do
   mpd <- lookupEnv "MP_DEBUG"
@@ -51,64 +63,40 @@ main = do
 
       it "should parse an unconditional" $ do
         parseR (pRule <* eof) "" (exampleStream ",,,,\n,EVERY,person,,\n,MUST,,,\n,->,sing,,\n")
-          `shouldParse`
-          [ Regulative {
-              every = "person"
-              , who = Nothing
-              , cond = Nothing
-              , deontic = DMust
-              , action = ("sing",[])
-              , temporal = Nothing
-              } ]
+          `shouldParse` [ defaultReg { every = "person"
+                                     , deontic = DMust
+                                     , action = ("sing",[])
+                                     } ]
 
       it "should parse a single OtherVal" $ do
         parseR (pRule <* eof) "" (exampleStream ",,,,\n,EVERY,person,,\n,WHO,walks,,\n,MUST,,,\n,->,sing,,\n")
-          `shouldParse`
-          [ Regulative {
-              every = "person"
-              , who = Just (Leaf "walks")
-              , cond = Nothing
-              , deontic = DMust
-              , action = ("sing",[])
-              , temporal = Nothing
-              } ]
+          `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`
-          [ Regulative {
-              every = "person"
-              , who = Just (All
-                ( Pre "Who" )
-                [ Leaf "walks"
-                , Leaf "runs"
-                , Any
-                  ( Pre "any of:" )
-                  [ Leaf "eats"
-                  , Leaf "drinks"
-                  ]
-                ])
-              , cond = Nothing
-              , deontic = DMust
-              , action = ("sing", [])
-              , temporal = Nothing
-              } ]
-
-      let imbibeRule = [ Regulative {
-                           every = "person"
-                           , who = Just (Any
-                             ( Pre "Who" )
-                             [ Leaf "walks"
-                             , Leaf "runs"
-                             , Leaf "eats"
-                             , All ( Pre "all of:" )
-                               [ Leaf "drinks"
-                               , Leaf "swallows" ]
-                             ])
-                           , cond = Nothing
-                           , deontic = DMust
-                           , action = ("sing", [])
-                           , temporal = Nothing
+          `shouldParse` [ defaultReg {
+                            who = Just (All
+                                         ( Pre "Who" )
+                                         [ Leaf "walks"
+                                         , Leaf "runs"
+                                         , Any
+                                           ( Pre "any of:" )
+                                           [ Leaf "eats"
+                                           , Leaf "drinks"
+                                           ]
+                                         ])
+                            } ]
+
+      let imbibeRule = [ defaultReg {
+                           who = Just (Any
+                                       ( Pre "Who" )
+                                       [ Leaf "walks"
+                                       , Leaf "runs"
+                                       , Leaf "eats"
+                                       , All ( Pre "all of:" )
+                                         [ Leaf "drinks"
+                                         , Leaf "swallows" ]
+                                       ])
                            } ]
 
       it "should parse indentedDummySing" $ do
@@ -137,17 +125,13 @@ main = do
         mycsv <- BS.readFile "test/simple-constitutive-1-checkboxes.csv"
         parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` [degustates]
 
-      let imbibeRule2 = [ Regulative
-                          { every = "person"
-                          , who = Just $ All
+      let imbibeRule2 = [ defaultReg
+                          { who = Just $ All
                                   ( Pre "Who" )
                                   [ Leaf "walks"
                                   , Leaf "degustates"
                                   ]
-                          , cond = Nothing
-                          , deontic = DMust
                           , action = ("sing", [])
-                          , temporal = Nothing
                           }
                         , Constitutive
                           { term = "degustates"
@@ -159,20 +143,44 @@ main = do
         mycsv <- BS.readFile "test/indented-2.csv"
         parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` imbibeRule2
 
-      let if_king_wishes = [ Regulative
-                          { every = "person"
-                          , who = Just $ All
+      let if_king_wishes = [ defaultReg
+                          { who = Just $ All
                                   ( Pre "Who" )
                                   [ Leaf "walks"
                                   , Leaf "eats"
                                   ]
                           , cond = Just $ Leaf "the King wishes"
-                          , deontic = DMust
-                          , action = ("sing", [])
-                          , temporal = Nothing
                           }
                         ]
 
+      let king_pays_singer = [ defaultReg
+                          { every = "King"
+                          , deontic = DMay
+                          , action = ("pay", [])
+                          , temporal = Just (TAfter "20min")
+                          }
+                        ]
+
+      let singer_must_pay = [ defaultReg
+                              { every = "Singer"
+                              , deontic = DMay
+                              , action = ("pay", [])
+                              , temporal = Just (TBefore "supper")
+                              }
+                        ]
+
+      let singer_chain = [ defaultReg
+                         { every = "person"
+                         , who = Just $ All
+                                 ( Pre "Who" )
+                                 [ Leaf "walks"
+                                 , Leaf "eats"
+                                 ]
+                         , cond = Just $ Leaf "the King wishes"
+                         , hence = Just king_pays_singer
+                         , lest  = Just singer_must_pay
+                         } ]
+
       it "should parse kingly permutations 1" $ do
         mycsv <- BS.readFile "test/if-king-wishes-1.csv"
         parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` if_king_wishes
@@ -185,9 +193,17 @@ main = do
         mycsv <- BS.readFile "test/if-king-wishes-3.csv"
         parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` if_king_wishes
 
---      it "should parse chained-regulatives.csv" $ do
---        mycsv <- BS.readFile "test/chained-regulatives.csv"
---        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` imbibeRule2
+      it "should parse chained-regulatives part 1" $ do
+        mycsv <- BS.readFile "test/chained-regulatives-part1.csv"
+        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` imbibeRule2
+
+      it "should parse chained-regulatives part 2" $ do
+        mycsv <- BS.readFile "test/chained-regulatives-part2.csv"
+        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` imbibeRule2
+
+      it "should parse chained-regulatives.csv" $ do
+        mycsv <- BS.readFile "test/chained-regulatives.csv"
+        parseR (pRule <* eof) "" (exampleStream mycsv) `shouldParse` imbibeRule2
 
       it "should render a box" $ do
         asBoxes <$> asCSV indentedDummySing

mengwong/mp/test/chained-regulatives-part1.csv

@@ -0,0 +1,3 @@
+PARTY,King,,
+MAY,AFTER,20min,
+->,pay,,

mengwong/mp/test/chained-regulatives-part2.csv

@@ -0,0 +1,2 @@
+Singer,MUST,BEFORE,supper
+,->,pay,

mengwong/mp/test/chained-regulatives.csv

@@ -0,0 +1,11 @@
+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,

mengwong/mp/test/if-king-wishes-1.csv

@@ -2,5 +2,5 @@ EVERY,person,,
 WHO,walks,,
 AND,eats,,
 MUST,,,
-IF,the King wishes,,
-->,sing,,
+IF,the King wishes,//,scope quantification slightly different vs 4
+->,sing,//,suggests that the King is consulted for each person

mengwong/mp/test/if-king-wishes-4.csv

@@ -1,6 +1,6 @@
-IF,the King wishes,,
-EVERY,person,,
-WHO,walks,,
-AND,eats,,
-MUST,,,
-->,sing,,
+IF,the King wishes,,// we could call this a meta-rule relation
+THEN,EVERY,person,
+,WHO,walks,
+,AND,eats,
+,MUST,,
+,->,sing,