Parser.hs

module Parser where

import Control.Applicative
import Control.Monad

------------------------------------------------------------------------------
-- Definition
------------------------------------------------------------------------------

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

------------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------------

instance Functor (Parser s) where
  fmap f px = Parser $ \s -> do { (x, s') <- runParser px s
                                ; return (f x, s')
                                }

instance Applicative (Parser s) where
  pure x    = Parser $ \s -> [(x, s)]
  
  pf <*> px = Parser $ \s -> do { (f, s')  <- runParser pf s
                                ; (x, s'') <- runParser px s'
                                ; return (f x, s'')
                                }

instance Monad (Parser s) where
  px >>= fp = Parser $ \s -> do { (x, s') <- runParser px s
                                ; runParser (fp x) s'
                                }

instance Alternative (Parser s) where
  empty     = Parser $ \_ -> []
  
  px <|> py = Parser $ \s -> case runParser px s of
                                []  -> runParser py s
                                res -> res

------------------------------------------------------------------------------
-- Combinators
------------------------------------------------------------------------------

choice :: [Parser s a] -> Parser s a
choice ps = foldr (<|>) empty ps

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

count :: Int -> Parser s a -> Parser s [a]
count n p = sequenceA (replicate n p)

option :: a -> Parser s a -> Parser s a
option x p = p <|> pure x

skipMany :: Parser s a -> Parser s ()
skipMany p  = void $ many p

skipMany1 :: Parser s a -> Parser s ()
skipMany1 p = void $ many1 p

sepBy :: Parser s a -> Parser s sep -> Parser s [a]
sepBy px ps = sepBy1 px ps <|> pure []

sepBy1 :: Parser s a -> Parser s sep -> Parser s [a]
sepBy1 px ps = (:) <$> px <*> many (ps *> px)

------------------------------------------------------------------------------
-- Basic parsers
------------------------------------------------------------------------------

top :: Parser [a] a
top = Parser $ \s -> case s of
                      (c:cs)    -> [(c, cs)]
                      otherwise -> []

satisfy :: (a -> Bool) -> Parser [a] a
satisfy p = top >>= \c -> if p c then
                              return c
                            else
                              empty

item :: Eq a => a -> Parser [a] a
item c = satisfy (== c)

oneOf :: Eq a => [a] -> Parser [a] a
oneOf xs = satisfy (`elem` xs)

string :: Eq a => [a] -> Parser [a] [a]
string cs = sequenceA (map item cs)

------------------------------------------------------------------------------
-- Char parsers
------------------------------------------------------------------------------

digit :: Parser [Char] Char
digit = oneOf ['0'..'9']

integer :: Parser [Char] Integer
integer = read <$> many1 digit