Merge pull request #242 from jacobpake/chain-prefix-postfix-operators

Chaining of prefix and postfix operators

Author: jamesdbrock

CHANGELOG.md

@@ -8,6 +8,8 @@ Bugfixes:
 
 Breaking changes:
 
+- `Prefix` and `Postfix` operators in `Parsing.Expr` are chained. (#242 by @jacobpake)
+
 New features:
 
 Other improvements:

src/Parsing/Expr.purs

@@ -13,9 +13,9 @@ import Prelude hiding (between)
 
 import Control.Alt ((<|>))
 import Data.Foldable (foldl, foldr)
-import Data.List (List(..), (:))
+import Data.List (List(..), reverse, (:))
 import Parsing (ParserT)
-import Parsing.Combinators (choice, (<?>))
+import Parsing.Combinators (choice, many, (<?>))
 
 data Assoc = AssocNone | AssocLeft | AssocRight
 
@@ -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 = rchainP postfixOp
+  prefixP = lchainP 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,12 @@ nassocP x nassocOp prefixP term postfixP = do
   y <- termP prefixP term postfixP
   pure (f x y)
 
+rchainP :: forall m s a. ParserT s m (a -> a) -> ParserT s m (a -> a)
+rchainP p = flip (foldl (\acc f -> f acc)) <$> many p
+
+lchainP :: forall m s a. ParserT s m (a -> a) -> ParserT s m (a -> a)
+lchainP p = flip (foldl (\acc f -> f acc)) <$> reverse <$> many p
+
 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'))