Applicative parsing in Haskell

I reread the famous functional pearl Monadic parsing in Haskell by Hutton & Meijer (1998). The arithmetic example they parse in the end is a (deterministic) context-free grammar, so (as we know today) we don’t need a monad here—we can get by with the weaker applicative functor. As a little exercise to get back into Haskell, I translated the monadic parser to an applicative parser.¹

Here is the hyperlinked outline of this post.

• Parser type
• Typeclasses
  • Functor
  • Applicative
  • Alternative
• Simple combinators
  • sat
  • char
• Recursive combinators
  • string
  • many and sepby
  • chainl
• Lexical combinators
• Parsing arithmetic expressions
• Afterthoughts

Parser type

Instead of a function that takes a string and returns a list (of tuples), I implement the parser as a function that returns a Maybe.

newtype Parser a = Parser (String -> Maybe (a, String))

We’re implementing a deterministic parser, so we only ever need one result.

The parse function remains unchanged except for the type signature.

parse :: Parser a -> String -> Maybe (a, String)
parse (Parser p) = p

In the definition of the item parser, we only replace the list by the Maybe constructors.

item :: Parser Char
item =
  Parser
    ( \cs -> case cs of
        "" -> Nothing
        (c : cs) -> Just (c, cs)
    )

Typeclasses

A littler refresher on some Haskell typeclasses and their implementation for the Parser type.

Functor

Let f be any type with a single type variable a and let a -> b be any function that takes an input of type a to an output of type b. We can make f an instance of the Functor typeclass by implementing the function fmap.

class Functor f where
  fmap :: (a -> b) -> f a -> f b

fmap maps the unary function of type a -> b over f’s values of type a to produce a result of type f b. There’s also a handy infix synonym for fmap.

(<$>) :: Functor f => (a -> b) -> f a -> f b
(<$>) = fmap

Instances of Functor need to obey the functor laws (apparently proving only the first law is enough).

1. Identity: fmap id = id
2. Composition: fmap (f . g) = fmap f . fmap g

Here is a simple instance of a functor from the standard library:

data Maybe a  =  Nothing | Just a

instance Functor Maybe where
  fmap _ Nothing = Nothing
  fmap f (Just x) = Just (f x)

We define a type Maybe with two type constructors: a nullary constructor Nothing and a unary constructor Just. Then we make Maybe an instance of the functor typeclass by implementing fmap. The first functor law obviously holds.

How can we use this? We can return a Maybe Int as the result of a computation and add a number without explicitly handling the error case.

fmap (*3) $ Just 2 -- Just 6
(*3) <$> Just 2    -- Just 6
(*3) <$> Nothing   -- Nothing

Coming from modern mainstream languages, fmap is probably most familiar from map on lists. In Haskell, the list type is just another instance of the functor typeclass.

(*3) <$> [1,2,3] -- [3,6,9]

The implementation of fmap for our parser type is slightly more involved.

instance Functor Parser where
  fmap f p =
    Parser
      ( \cs -> case parse p cs of
          Just (v, cs') -> Just (f v, cs')
          Nothing -> Nothing
      )

We define a function that applies the parser p to its input and distinguishes two cases:

1. The parser has a result for the given input, so the output is Just (f v, cs'), where f is a applied to the first component of the parser output, or
2. The parser has no result, so the function returns Nothing.

So far this is not terribly useful, but we can already do something like this:

parse (fmap toLower item) "TEST" -- Just ('t',"EST")

Applicative

We can fmap a unary function over a functor, but what about functions that take more arguments? How do we use them with functors? This is where the Applicative typeclass comes into play.

class Functor f => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b
  
  -- optional functions with default implementations
  liftA2 :: (a -> b -> c) -> f a -> f b -> f c
  liftA2 f x = (<*>) (fmap f x)

  (*>) :: f a -> f b -> f b
  a1 *> a2 = (id <$ a1) <*> a2

  (<*) :: f a -> f b -> f a
  (<*) = liftA2 const

Applicative builds on the functor typeclass (note the type constraint Functor f =>) and requires two more functions to be implemented: pure simply wraps any value into an applicative functor. <*>—sometimes called apply / applied (to), sometimes splat—applies a function of type a -> b within a functor to a value of type a within another functor to produce a functor with a value of type b.²

These methods should obey the four applicative functor laws.

1. Identity: pure id <*> v = v
2. Homomorphism: pure f <*> pure x = pure (f x)
3. Interchange: u <*> pure y = pure ($ y) <*> u
4. Composition: pure (.) <*> u <*> v <*> w = u <*> (v <*> w)

Here is the implementation for Maybe:

instance Applicative Maybe where
  pure = Just
  Just f <*> m = fmap f m
  _ <*> _ = Nothing

pure is just Just. For <*>, I pattern match the function f out of the left functor and fmap it over the right functor m. If that’s not possible, <*> produces Nothing.

Now we can, for example, apply a binary function to two applicative functors:

(+) <$> Just 2 <*> Just 3 
-- Just 5

We fmap (+) over the first functor and then apply the resulting functor of type Num a => Maybe (a -> a) to the second functor.

Apart from the minimal set of two functions we have to implement, the Applicative typeclass comes with a few useful default function implementations. liftA2 applies a binary function to two values wrapped in applicative functors, so instead of (+) <$> Just 2 <*> Just 3, we could write liftA2 (+) (Just 3) (Just 5). *> and <* work like <*>, however, the output of the left or right argument is thrown away (that of the side with the missing angle bracket).

The implementation for the Parser type won’t come as a big surprise.

instance Applicative Parser where
  pure v = Parser (\cs -> Just (v, cs))

  pf <*> pv =
    Parser
      ( \cs -> case parse pf cs of
          Just (f, cs') -> parse (fmap f pv) cs'
          Nothing -> Nothing
      )

Now we’re able to chain multiple parsers. Here is a stupid example.

parse ((:) <$> item <*> fmap (:[]) item) "TEST"
-- Just ("TE","ST")

Alternative

Building on top of Applicative, we have another typeclass called Alternative, which is able to combine two applicative functors. We need to implement two functions to make an applicative functor an instance of Alternative.

class Applicative f => Alternative f where
  empty :: f a
  (<|>) :: f a -> f a -> f a

The first operation just returns a ‘zero’ result. The second operation is a binary function that combines two applicative functors. Together these two operations form a monoid, and Applicative should obey the monoid laws.³

1. Neutral element: empty <|> u = u and u <|> empty = u
2. Associativity: u <|> (v <|> w) = (u <|> v) <|> w

In case of our parser, <|> will be the deterministic choice operator (+++ in the paper).

instance Alternative Parser where
  empty = Parser (\cs -> Nothing)
  p <|> q =
    Parser
      ( \cs -> case parse p cs of
          Just x -> Just x
          Nothing -> parse q cs
      )

If the first parser succeeds, we return its output, otherwise the output of the second parser (potentially Nothing).

Simple combinators

Two combinators dealing with single characters.

sat

sat consumes one char from the input if it satisfies a boolean predicate, otherwise it fails to parse anything.

sat :: (Char -> Bool) -> Parser Char
sat p =
  Parser
    ( \cs -> case cs of
        (c : cs) | p c -> Just (c, cs)
        _otherwise -> Nothing
    )

char

char parses a single specified character from the input or nothing.

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

Recursive combinators

A bit of recursion for dealing with strings and infinite languages.

string

string tries to parse a given string by repeatedly applying char to the first remaining character and recursing down the rest.

string :: String -> Parser String
string "" = pure ""
string (c : cs) = (:) <$> char c <*> string cs

many and sepby

To parse repeated applications of a parser p, we could implement many as follows:

many :: Parser a -> Parser [a]
many p = many1 p <|> pure []

many1 :: Parser a -> Parser [a]
many1 p = (:) <$> p <*> many p 

Luckily, Alternative in GHC.Base comes with a default implementation that we can use out of the box.

sepby tries to parse multiple occurences of a parser p separated by another parser sep, only keeping the results of p.

sepby :: Parser a -> Parser b -> Parser [a]
sepby p sep = sepby1 p sep <|> pure []

sepby1 :: Parser a -> Parser b -> Parser [a]
sepby1 p sep = (:) <$> p <*> many (sep *> p)

Note that (:) is a binary function of the type a -> [a] -> [a], which when fmapped (<$>) over p produces a parser of type Parser ([a] -> [a]), which then is applied to another parser of type Parser [a] to produce Parser [a].

chainl

chainl parses zero or more occurences of parser p with a value of type a, separated by a parser op with a binary function of type a -> a -> a. It returns a parser with the result of the left-associative applications of the functions of op to the values of p or a provided default value.

chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op x = chainl1 p op <|> pure x

For example, p might parse single digits and op consumes the character + and applies the binary function (+) to two values, then the string 1+2+3+4 would evaluate to $((1+2)+3)+4 = 10$.

The implementation of chainl1 is a bit tricky, so I’ll slowly work towards it in a few steps. Since we’re trying to combine a list of numbers with a left-associative binary operation, it seems natural to use foldl. The idea is to parse the first digit and then combine it with the remaining input (digit operation)*.

I’ll first try to parse the example input 1+2+3+4. Instead of addition, I’ll use string concatenation to see what’s going on.

-- Consume "+" and return concatenation parser
cc = string "+" $> (++)
-- Parse digit as string
dd = many (sat isDigit)

I start from the back and parse +2+3+4.

parse (many (cc <*> dd <*> pure "+")) "+1+2+3"
-- Just (["1+","2+","3+"],"")

The <*> pure "+" part is just there to get a nice printable list of strings—without it, we’d get a list of unary functions (for which we have no instance of Show). The plus symbol indicates where the second argument would go. Note that we involuntarily changed the order, because the digit is bound as the first argument to the binary function. We need to flip this around.

parse (many (flip <$> cc <*> dd <*> pure "+")) "+1+2+3"
-- Just (["+1","+2","+3"],"")

Now we just need to use foldl to apply the first function to the first digit, the second function to the result of the previous application and so on. Check out the type of foldl:

:t foldl
-- foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b

It expects a binary function first, then an initial value, then a foldable type (in our case a list). However, we have a value (the first digit) and a list of unary functions, so this doesn’t quite fit. To make it fit, we need a binary function that takes a digit as first argument and a unary function as second argument. But this is just ($) with flipped arguments.

:t (flip ($))
-- (flip ($)) :: a -> (a -> c) -> c

Now everything is falling into place and we can implement chainl1.

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p op = foldl' (flip ($)) <$> p <*> many (flip <$> op <*> p)

Lexical combinators

space parses a string of only whitespace and is just copied from the original paper.

space :: Parser String
space = many (sat isSpace)

token parses the given parser p, throwing away any trailing space. The applicative definition is simpler than the monadic one.

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

symb parses a given string, throwing away any trailing space (copied from the paper).

symb :: String -> Parser String
symb cs = token (string cs)

apply, like parse, applies the parser p, but throwing away leading whitespace. Again, the applicative definition is very short.

apply :: Parser a -> String -> Maybe (a, String)
apply p = parse (space *> p)

Parsing arithmetic expressions

We start with a little helper function that converts a digit character to an integer.

char2digit :: Char -> Int
char2digit x = ord x - ord '0'

Now we implement the arithmetic expression parser. Thanks to our previous efforts, we can stay pretty close to the formal grammar.

expr :: Parser Int
expr = term `chainl1` addop
term = factor `chainl1` mulop
factor = digit <|> ((symb "(" *> expr) <* symb ")")
digit = char2digit <$> token (sat isDigit)

addop :: Parser (Int -> Int -> Int)
addop = (symb "+" $> (+)) <|> (symb "-" $> (-))

mulop :: Parser (Int -> Int -> Int)
mulop = (symb "*" $> (*)) <|> (symb "/" $> (div))

Finally, the test case from the paper:

apply expr " 1 - 2 * 3 + 4 "
-- Just (-1, "")

Afterthoughts

It’s fun to play with typeclasses and the code looks very nice and concise. On a pessimist note, I went down a rabbit hole of typeclass laws (people can’t even agree on the laws for the Alternative typeclass) and it took a bit of time to get used to all the cryptic operators and their type signatures. The result is a simple recursive descent parser with questionable performance and without proper error handling—if your input is not well-formed, you’ll simply get Nothing. Of course, this is just an instructional example and for any real parsing work, you’d use a library like parsec or flatparse.