Parsing with Parser Combinators

27.1 Building a Parser from Scratch

import Control.Applicative (Alternative (..))
import Data.Char (isDigit, isSpace)

newtype Parser a = Parser {runParser :: String -> Maybe (a, String)}

instance Functor Parser where
  fmap f (Parser p) = Parser $ \s -> case p s of
    Nothing -> Nothing
    Just (a, rest) -> Just (f a, rest)

instance Applicative Parser where
  pure x = Parser $ \s -> Just (x, s)
  Parser pf <*> Parser pa = Parser $ \s -> case pf s of
    Nothing -> Nothing
    Just (f, rest) -> case pa rest of
      Nothing -> Nothing
      Just (a, rest') -> Just (f a, rest')

instance Monad Parser where
  Parser p >>= f = Parser $ \s -> case p s of
    Nothing -> Nothing
    Just (a, rest) -> runParser (f a) rest

instance Alternative Parser where
  empty = Parser (const Nothing)
  Parser p <|> Parser q = Parser $ \s -> case p s of
    Nothing -> q s
    result -> result

satisfy :: (Char -> Bool) -> Parser Char
satisfy pr = Parser $ \s -> case s of
  (c : cs) | pr c -> Just (c, cs)
  _ -> Nothing

char :: Char -> Parser Char
char c = satisfy (== c)

spaces :: Parser ()
spaces = () <$ many (satisfy isSpace)

token :: Parser a -> Parser a
token p = p <* spaces

number :: Parser Int
number = token (read <$> some 
…

27.2 Megaparsec (Production-Quality)

Other parsing libraries: parsec (classic), attoparsec (fast, for ByteString/Text protocols), trifecta, Earley, happy/alex (parser/lexer generators used by GHC itself).

{-# LANGUAGE OverloadedStrings #-}
import Data.Text (Text)
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Control.Monad.Combinators.Expr

type Parser = Parsec Void Text

sc :: Parser ()
sc = L.space space1 (L.skipLineComment "--") (L.skipBlockComment "{-" "-}")

lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc

symbol :: Text -> Parser Text
symbol = L.symbol sc

integer :: Parser Integer
integer = lexeme L.decimal

parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")

data Expr = Num Integer | Add Expr Expr | Sub Expr Expr | Mul Expr Expr | Neg Expr deriving Show

exprP :: Parser Expr
exprP = makeExprParser termP
  [ [Prefix (Neg <$ symbol "-")]
  , [InfixL (Mul <$ symbol "*")]
  , [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
  ]

termP :: Parser Expr
termP = parens exprP <|> Num <$> integer

main :: IO ()
main = case parse (sc *> exprP <* eof) "input" "1 + 2 * (3 - -4)" of
  Left err -> putStr (errorBundlePretty err)       -- excellent error messages
  Right ast -> print ast