megaparsec-negatedpow.hs

#!/usr/bin/env stack
-- stack --resolver lts-8.19 script --system-ghc --package megaparsec

import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Error
import Text.Megaparsec.Expr
import Text.Megaparsec.Lexer


data Expr = Val Integer
          | Pow Expr Expr
          | Mult Expr Expr
          | Negate Expr

instance Show Expr where
    show (Val x) = show x
    show (Pow x y) = "(" ++ show x ++ " ^ " ++ show y ++ ")"
    show (Mult x y) = "(" ++ show x ++ " * " ++ show y ++ ")"
    show (Negate x) = "-(" ++ show x ++ ")"

expr = makeExprParser term table <?> "expression"

term = Val <$> integer <?> "term"

table = [ [ InfixR (char '^' >> return Pow) ]
        , [ Prefix (char '-' >> return Negate) ]
        , [ InfixL (char '*' >> return Mult) ]
        ]

run :: String -> Either (ParseError (Token String) Dec) Expr
run s = runParser (expr <* eof) "" s

test s = do
    putStrLn s
    putStrLn $ either parseErrorPretty show $ run s
    putStrLn ""

main = do
    test "-3*2"
    test "3*-2"
    test "-3^2"
    test "3^-2"

-- output:
-- -3*2
-- (-(3) * 2)
-- 
-- 3*-2
-- (3 * -(2))
-- 
-- -3^2
-- -((3 ^ 2))
-- 
-- 3^-2
-- 1:3:
-- unexpected '-'
-- expecting term