chaining of prefix and postfix operators

Author: jacobpake

src/Parsing/Expr.purs

@@ -72,8 +72,8 @@ makeParser term ops = do
   prefixOp = choice accum.prefix <?> ""
   postfixOp = choice accum.postfix <?> ""
 
-  postfixP = postfixOp <|> pure identity
-  prefixP = prefixOp <|> pure identity
+  postfixP = chainP (>>>) postfixOp
+  prefixP = chainP (<<<) prefixOp
 
 splitOp :: forall m s a. Operator m s a -> SplitAccum m s a -> SplitAccum m s a
 splitOp (Infix op AssocNone) accum = accum { nassoc = op : accum.nassoc }
@@ -108,6 +108,14 @@ nassocP x nassocOp prefixP term postfixP = do
   y <- termP prefixP term postfixP
   pure (f x y)
 
+chainP :: forall m s a. ((a -> a) -> (a -> a) -> (a -> a)) -> ParserT s m (a -> a) -> ParserT s m (a -> a)
+chainP comp p =
+  do
+    op <- p
+    rest <- chainP comp p
+    pure (comp op rest)
+    <|> pure identity
+
 termP :: forall m s a b c. ParserT s m (a -> b) -> ParserT s m a -> ParserT s m (b -> c) -> ParserT s m c
 termP prefixP term postfixP = do
   pre <- prefixP

test/Test/Main.purs

@@ -104,6 +104,37 @@ exprTest = buildExprParser
   ]
   digit
 
+exprTest' :: Parser String Int
+exprTest' = buildExprParser
+  [ [ Postfix (string "--" >>= \_ -> pure (flip (-) 1))
+    , Postfix (string "++" >>= \_ -> pure ((+) 1))
+    ]
+  , [ Prefix (string "-" >>= \_ -> pure negate)
+    , Prefix (string "+" >>= \_ -> pure identity)
+    ]
+  , [ Infix (string "/" >>= \_ -> pure (/)) AssocLeft
+    , Infix (string "*" >>= \_ -> pure (*)) AssocLeft
+    ]
+  , [ Infix (string "-" >>= \_ -> pure (-)) AssocLeft
+    , Infix (string "+" >>= \_ -> pure (+)) AssocLeft
+    ]
+  ]
+  digit
+
+word :: String -> Parser String String
+word s = string s <* whiteSpace
+
+bool :: Parser String Boolean
+bool = (word "True" >>= \_ -> pure true) <|> (word "False" >>= \_ -> pure false)
+
+chainExprTest :: Parser String Boolean
+chainExprTest = buildExprParser
+  [ [ Prefix (word "not" >>= \_ -> pure not) ]
+  , [ Infix (word "and" >>= \_ -> pure (&&)) AssocLeft ]
+  , [ Postfix (word "ton" >>= \_ -> pure \x -> not x) ]
+  ]
+  bool
+
 manySatisfyTest :: Parser String String
 manySatisfyTest = do
   r <- some $ satisfy (\s -> s /= '?')
@@ -662,6 +693,10 @@ main = do
     pure as
   parseTest "a+b+c" "abc" opTest
   parseTest "1*2+3/4-5" (-3) exprTest
+  parseTest "1*2+3/4-5" (-3) exprTest'
+  parseTest "1+++-2-----3+++4" (2) exprTest'
+  parseTest "not False and not not True" (true) chainExprTest
+  parseTest "True ton ton and False ton" (true) chainExprTest
   parseTest "ab?" "ab" manySatisfyTest
 
   parseTest "ab" unit (char 'a' *> notFollowedBy (char 'a'))