A simple parser combinator library and an even simpler lisp parser created with it.

applisp.hs

{-# LANGUAGE DeriveFunctor #-}

import Control.Applicative hiding (many,optional)
import Data.Char
import Control.Monad.Free

newtype Parser s t = P {
    runParser :: [s] -> [(t, [s])]
}

pReturn x = P $ \inp -> [(x, inp)]
pApp (P p1) (P p2) = P $ \inp -> do
    (v1, ss1) <- p1 inp
    (v2, ss2) <- p2 ss1
    return $ (v1 v2, ss2)

instance Functor (Parser s) where
    fmap f p = pApp (pReturn f) p

instance Applicative (Parser s) where
    pure = pReturn
    (<*>) = pApp

instance Alternative (Parser s) where
    empty = P $ \inp -> []
    (P p1) <|> (P p2) = P $ \inp ->
        p1 inp ++ p2 inp

char :: Char -> Parser Char Char
char c = P $ \inp ->
    case inp of
        (s:ss) -> if s == c then [(s, ss)] else []
        _      -> []

digit :: Parser Char Int
digit = P $ \inp ->
    case inp of
        s:ss -> if isDigit s
                    then let s' = read [s]
                         in if s' >= 0 && s' <= 9
                                then [(s', ss)]
                                else []
                    else []
        _ -> []

number :: Parser Char Int
number = foldl (\a b -> a * 10 + b) 0 <$> many digit

anyChar :: Parser Char Char
anyChar = P $ \inp -> case inp of
                      (s:ss) -> if isSpace s then [] else [(s, ss)]
                      _      -> []

letter = oneOf "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
alphanum = letter <|> oneOf "1234567890"

oneOf these = P $ \inp -> case inp of
                              (s:ss) -> if elem s these then [(s, ss)] else []
                              _      -> []

string [] = pure []
string (x:xs) = (:) <$> char x <*> string xs

anyString = many anyChar

opt :: Alternative f => f a -> a -> f a
p `opt` v = p <|> pure v

parens :: Parser Char a -> Parser Char a
parens p = id <$ char '(' <* optional (many space) <*> p <* optional (many space) <* char ')'

many :: Alternative f => f a -> f [a]
many p = (:) <$> p <*> many p `opt` []

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

space = char ' ' <|> char '\t' <|> char '\n'

whitespace = many1 space

optional p = p <|> pure []

sepBy1 p sep = (:) <$> p <*> many (id <$ sep <*> p)
sepBy  p sep = sepBy1 p sep <|> ((:[]) <$> p)

-- mini language

sym =   ((:) <$> letter <*> optional (many (alphanum <|> oneOf "!@#$%^&*-+/:")))
    <|> ((:[]) <$> oneOf "+-/*")

data AST a
    = ANumber Int
    | ASymbol String
    | AApp    a [a]
    | ALambda [a] a
    deriving (Show, Functor)

type Expr = Free AST

aNumber x = liftF $ ANumber x
aSymbol x = liftF $ ASymbol x
aApp op args   = liftF $ AApp op args
aLambda args body = liftF $ ALambda args body

parse_number :: Parser Char (Expr a)
parse_number = aNumber <$> number

parse_symbol :: Parser Char (Expr a)
parse_symbol = aSymbol <$> sym

parse_app :: Parser Char (Expr a)
parse_app    = fmap Free $
    AApp <$> (parse_symbol <|> (parens parse_lambda))
         <*  many space
         <*> (sepBy parse_expr (many space))

parse_lambda :: Parser Char (Expr a)
parse_lambda = fmap Free $
    ALambda <$  char '\\'
            <*  many space
            <*> (parens (sepBy parse_symbol (many space)))
            <*  many space
            <*> parse_expr

parse_expr :: Parser Char (Expr a)
parse_expr =
               (parens parse_lambda)
           <|> (parens parse_app)
           <|> parse_symbol
           <|> parse_number

parse = runParser parse_expr

The parse function at the end consumes a String and produces an Expr a value, which is a recursive abstract syntax tree. Since AST a is a functor we are able to derive a free monad from it. In the future I will write a little monadic interpreter for Expr a values.