This is my first non-trivial Haskell project, an expression parser implemented using the Pratt Parser's technique for managing precedence as a layer on top of Parsec.  It simply builds an expression tree and then pretty-prints it using Text.PrettyPrint.  Would welcome any comments, but am particularly interested about where I should or should not have used point-free style, particularly in monad-handling code.module Main where---------------------------------------------------------------------------------- dependencies--------------------------------------------------------------------------------import Text.Parsec-- Applicative has several operators that conflict with the Parsec combinators, -- but we want to be able to use <*, which Parsec lacks:import Control.Applicative ((<*))       import qualified Text.PrettyPrint as PPimport qualified Data.Map as Mapimport Data.Map ((!))import Text.Show.Functions          -- for debugging purposes only---------------------------------------------------------------------------------- basic data types--------------------------------------------------------------------------------data Expr =    BinOp Expr String Expr |    PrefixOp String Expr |    IntValue Integer |    IfThenElse Expr Expr Expr    deriving Showtype StringParser r = Parsec String () rtype ExprParser = StringParser Exprdata OperatorPrecedence = LAssoc Int | RAssoc Int                          deriving (Show, Eq)data OperatorInfo = OperatorInfo String OperatorPrecedence LeftDenotation                    deriving Show-- a LeftDenotation is a function for producing a parser that binds to a -- left hand termtype LeftDenotation = OperatorInfo -> Expr -> ExprParser---------------------------------------------------------------------------------- utility functions for formatted output--------------------------------------------------------------------------------pPrint :: Expr -> PP.DocpPrint (BinOp l op r) =  PP.vcat [PP.text $ (BinOp  ++ op,                      PP.nest 4 $ pPrint l,                      PP.nest 4 $ pPrint r,                       PP.text )]pPrint (IfThenElse c t f) =  PP.vcat [PP.text $ (If,                      PP.nest 4 $ pPrint c,                      PP.nest 4 $ pPrint t,                      PP.nest 4 $ pPrint f,                       PP.text )]pPrint x = PP.text $ show xparseToText :: ExprParser -> String -> StringparseToText parser input = case (parse parser input input) of       Left error -> show error       Right expr -> PP.render $ pPrint expr---------------------------------------------------------------------------------- parser definitions--------------------------------------------------------------------------------       -- apply optional trailing whitespace to a parserwsopt :: StringParser t -> StringParser twsopt p = p <* optional spaces-- parse an integer value (with optional trailing whitespace)parseIntValue :: ExprParser parseIntValue = wsopt (many1 digit) >>= \ x -> return (IntValue (read x))-- parse an operator symboloperator :: StringParser Stringoperator = try (string ifTrue) <|> many1 (oneOf <>:@~\\/|!$%^&*-_=+)-- operator dataoperatorInfoPrecedence :: OperatorInfo -> OperatorPrecedenceoperatorInfoPrecedence (OperatorInfo _ p _) = poperatorList :: [OperatorInfo]operatorList = [    OperatorInfo - (LAssoc 50) parseStdOp,    OperatorInfo + (LAssoc 50) parseStdOp,    OperatorInfo | (LAssoc 40) parseStdOp,    OperatorInfo * (LAssoc 70) parseStdOp,    OperatorInfo & (LAssoc 60) parseStdOp,    OperatorInfo / (LAssoc 70) parseStdOp,    OperatorInfo < (LAssoc 30) parseStdOp,    OperatorInfo > (LAssoc 30) parseStdOp,    OperatorInfo <= (LAssoc 30) parseStdOp,    OperatorInfo >= (LAssoc 30) parseStdOp,    OperatorInfo || (LAssoc 10) parseStdOp,    OperatorInfo && (LAssoc 20) parseStdOp,    OperatorInfo ^ (RAssoc 90) parseStdOp,    OperatorInfo ifTrue (RAssoc 5) parseIfOp]operatorMap :: Map.Map String OperatorInfooperatorMap = Map.fromList (map mkOpInfoTuple operatorList)    where        mkOpInfoTuple opInfo@(OperatorInfo name _ _) = (name, opInfo)operatorPrecedence :: String -> OperatorPrecedenceoperatorPrecedence name = operatorInfoPrecedence (operatorMap ! name)-- parse an operator only if the next operator has at least minimum precedence-- (will usually be used with 'try', so error message caused on failure should -- never appear in output)operatorWithMinimumPrecedence :: Int -> StringParser StringoperatorWithMinimumPrecedence min = do    op <- wsopt operator    case operatorPrecedence op of        LAssoc precedence            | precedence >= min -> return op        RAssoc precedence            | precedence >= min -> return op        _                      -> fail Precedence below minimum expected-- parse <operator> <expression>parsePrefixOp :: ExprParserparsePrefixOp = do    op <- wsopt operator    rhs <- parseExpr    return $ PrefixOp op rhs-- parse '(' <expression> ')'parseBracketExpr :: ExprParserparseBracketExpr = between openBracket closeBracket parseExpr    where openBracket = wsopt (char '(')          closeBracket = wsopt (char ')')-- parse a binary operator with standard semanticsparseStdOp :: LeftDenotationparseStdOp (OperatorInfo name precedence _) lhs = do    rhs <- parseExprWithMinimumPrecedence (precedence)    return (BinOp lhs name rhs)-- parse an if-then-else operatorparseIfOp :: LeftDenotationparseIfOp (OperatorInfo name precedence _) condition = do    trueExpr <- parseExprWithMinimumPrecedence precedence    string else    falseExpr <- parseExprWithMinimumPrecedence precedence    return $ IfThenElse condition trueExpr falseExpr-- given an already parsed expression, parse <operator> <expression> that may -- optionally follow itparseInfix :: Int -> Expr -> ExprParserparseInfix precedence lhs = do    maybeOp <- optionMaybe (try (operatorWithMinimumPrecedence precedence))    case maybeOp of        Just name       -> bindOperatorLeft name lhs >>= parseInfix precedence        Nothing         -> return lhsbindOperatorLeft :: String -> Expr -> ExprParserbindOperatorLeft name lhs =     case (Map.lookup name operatorMap) of        Just opInfo@(OperatorInfo _ _ leftDenotation) ->             leftDenotation opInfo lhs        Nothing -> error $ Unknown operator \ ++ name ++ \-- parse termsparseTerm :: ExprParserparseTerm = parsePrefixOp <|> parseIntValue <|> parseBracketExpr-- parse expressionsparseExpr :: ExprParserparseExpr = parseExprWithMinimumPrecedence (LAssoc 0)parseExprWithMinimumPrecedence :: OperatorPrecedence -> ExprParserparseExprWithMinimumPrecedence precedence =     optional spaces >> parseTerm >>= parseInfix (precedenceValue precedence)    where        precedenceValue (LAssoc n) = n + 1        precedenceValue (RAssoc n) = n ---------------------------------------------------------------------------------- main - parse standard input--------------------------------------------------------------------------------main::IO()main = do   input <- getContents   putStrLn (parseToText parseExpr input)
Expression parser in Haskell using operator precedence table
parsing;haskell