Add the new debug machinery everywhere

mengwong/mp/src/Lib.hs

@@ -312,8 +312,7 @@ pRule = withDepth 1 $ do
     <|> (pConstitutiveRule <?> "constitutive rule")
 
 pConstitutiveRule :: Parser [Rule]
-pConstitutiveRule = do
-  debugPrint "pConstitutiveRule"
+pConstitutiveRule = debugName "pConstitutiveRule" $ do
   initialLocation <- lookAhead pXLocation
   myTraceM $ "pConstitutiveRule: initial location = " ++ show initialLocation
   term               <- (pOtherVal <* dnl) <?> "defined term"
@@ -325,12 +324,10 @@ pConstitutiveRule = do
   myTraceM $ "pConstitutiveRule: matched defWord " ++ show defWord
   myTraceM $ "pConstitutiveRule: \"" ++ Text.unpack term ++ "\" " ++ show defWord ++ "..."
   (ands,rs) <- withDepth leftX dBoolRules -- (foo AND (bar OR baz), [constitutive and regulative sub-rules])
-  let toreturn = Constitutive term ands : rs
-  myTraceM $ "pConstitutiveRule: returning " ++ show toreturn
-  return toreturn
+  return $ Constitutive term ands : rs
 
 pRegRule :: Parser [Rule]
-pRegRule = try pRegRuleSugary <|> pRegRuleNormal
+pRegRule = debugName "pRegRule" $ try pRegRuleSugary <|> pRegRuleNormal
 
 -- "You MAY" has no explicit PARTY or EVERY keyword:
 --
@@ -344,8 +341,7 @@ pRegRule = try pRegRuleSugary <|> pRegRuleNormal
 --       IF  a potato is available
 
 pRegRuleSugary :: Parser [Rule]
-pRegRuleSugary = do
-  debugPrint "pRegRuleSugary"
+pRegRuleSugary = debugName "pRegRuleSugary" $ do
   entitytype         <- pOtherVal
   leftX              <- lookAhead pXLocation -- this is the column where we expect IF/AND/OR etc.
 
@@ -373,8 +369,7 @@ pRegRuleSugary = do
 --    AND  the potato is not green
 
 pRegRuleNormal :: Parser [Rule]
-pRegRuleNormal = do
-  debugPrint "pRegRuleNormal"
+pRegRuleNormal = debugName "pRegRuleNormal" $ do
   leftX              <- lookAhead pXLocation -- this is the column where we expect IF/AND/OR etc.
   checkDepth
   (_party_every, entitytype)   <- pActor Party <|> pActor Every
@@ -404,8 +399,7 @@ pRegRuleNormal = do
   return ( toreturn : brs ++ ebrs )
 
 pHenceLest :: MyToken -> Parser [Rule]
-pHenceLest henceLest = do
-  debugPrint "pHenceLest"
+pHenceLest henceLest = debugName "pHenceLest" $ do
   leftX              <- lookAhead pXLocation -- this is the column where we expect IF/AND/OR etc.
   checkDepth
   pToken henceLest
@@ -456,7 +450,7 @@ data RuleBody = RuleBody { rbaction   :: ActionType -- pay(to=Seller, amount=$10
                       deriving (Eq, Show, Generic)
 
 permutations :: [MyToken] -> Parser RuleBody
-permutations whoifwhen = do
+permutations whoifwhen = debugName ("permutations" <> show whoifwhen) $ do
   toreturn <- permute ( RuleBody
                         <$$> pAction
                         <|?> ([], some $ preambleBoolRules whoifwhen) -- syntactic constraint, all the if/when need to be contiguous.
@@ -475,7 +469,7 @@ newPre t (AA.Any (AA.Pre     _p)    x) = AA.Any (AA.Pre     t   ) x
 newPre t (AA.Any (AA.PrePost _p pp) x) = AA.Any (AA.PrePost t pp) x
 
 preambleBoolRules :: [MyToken] -> Parser (Preamble, BoolRules)
-preambleBoolRules whoifwhen = do
+preambleBoolRules whoifwhen = debugName "preambleBoolRules" $ do
   leftX     <- lookAhead pXLocation -- this is the column where we expect IF/AND/OR etc.
   myTraceM ("preambleBoolRules: x location is " ++ show leftX)
   checkDepth
@@ -495,15 +489,13 @@ preambleBoolRules whoifwhen = do
   return toreturn
 
 dBoolRules ::  Parser BoolRules
-dBoolRules = do
-  debugPrint "dBoolRules"
+dBoolRules = debugName "dBoolRules" $ do
   ands     <- pAndGroup -- walks AND eats OR drinks
   myTraceM $ "dBoolRules: returning ands: " ++ show ands
   return ands
 
 pAndGroup ::  Parser BoolRules
-pAndGroup = do
-  debugPrint "pAndGroup"
+pAndGroup = debugName "pAndGroup" $ do
   orGroup1 <- pOrGroup
   orGroupN <- many $ dToken And *> pOrGroup
   let toreturn = if null orGroupN
@@ -514,9 +506,8 @@ pAndGroup = do
   return toreturn
 
 pOrGroup ::  Parser BoolRules
-pOrGroup = do
+pOrGroup = debugName "pOrGroup" $ do
   depth <- asks callDepth
-  debugPrint "pOrGroup"
   elem1    <- withDepth (depth + 1) pElement
   elems    <- many $ dToken Or *> withDepth (depth+1) pElement
   let toreturn = if null elems
@@ -527,8 +518,7 @@ pOrGroup = do
   return toreturn
 
 pElement ::  Parser BoolRules
-pElement = do
-  debugPrint "pElement"
+pElement = debugName "pElement" $ do
   -- think about importing Control.Applicative.Combinators so we get the `try` for free
   try pNestedBool
     <|> try (constitutiveAsElement <$> pConstitutiveRule)
@@ -539,8 +529,7 @@ constitutiveAsElement (cr:rs) = (Just (AA.Leaf (term cr)), cr:rs)
 constitutiveAsElement [] = error "constitutiveAsElement: cannot convert an empty list of rules to a BoolRules structure!"
 
 pLeafVal ::  Parser BoolRules
-pLeafVal = do
-  debugPrint "pLeafVal"
+pLeafVal = debugName "pLeafVal" $ do
   checkDepth
   leafVal <- pOtherVal <* dnl
   myTraceM $ "pLeafVal returning " ++ Text.unpack leafVal
@@ -549,8 +538,7 @@ pLeafVal = do
 -- should be possible to merge pLeafVal with pNestedBool.
 
 pNestedBool ::  Parser BoolRules
-pNestedBool = do
-  debugPrint "pNestedBool"
+pNestedBool = debugName "pNestedBool" $ do
   -- "foo AND bar" is a nestedBool; but just "foo" is a leafval.
   foundBool <- lookAhead (pLeafVal >> pBoolConnector)
   myTraceM $ "pNestedBool matched " ++ show foundBool
@@ -559,8 +547,7 @@ pNestedBool = do
   return toreturn
 
 pBoolConnector :: Parser MyToken
-pBoolConnector = do
-  debugPrint "pBoolConnector"
+pBoolConnector = debugName "pBoolConnector" $ do
   checkDepth
   andor <- pToken And <|> pToken Or <|> pToken Unless
   myTraceM $ "pBoolConnector returning " ++ show andor