module Parse (
    -- types
    Parser,
    -- functions
    anyToken, between, char, digit, eoi, letter, many, many1,
    manyTill, noneof, oneof, parse, sat, space, spaces, string, test,
    token,
    -- operators
    (<|>)
  ) where

import Control.Monad
import Control.Applicative hiding (many, (<|>))

-- parsers for tokens of type 't', returning results of type 'a'
newtype Parser t a =
  Parser { run :: [t] -> Maybe (a, [t]) }


-- primitive parsers

eoi :: Parser t ()
eoi = Parser $ \ts ->
  case ts of
    [] -> Just ((), [])
    x:xs -> Nothing

token :: (t -> Maybe a) -> Parser t a
token f = Parser $ \ts ->
  case ts of
    [] -> Nothing
    x:xs ->
      case f x of
        Just y  -> Just (y, xs)
        Nothing -> Nothing

lift :: a -> Parser t a
lift x = Parser $ Just . (,) x


-- primitive combinators

bind :: Parser t a -> (a -> Parser t b) -> Parser t b
bind p f = Parser $ \ts ->
  case run p ts of
    Just (x, ts') -> run (f x) ts'
    Nothing -> Nothing

(<|>) :: Parser t a -> Parser t a -> Parser t a
p <|> q = Parser $ \ts ->
  case run p ts of
    Nothing -> run q ts
    r -> r


-- monad instance for "Parser t"

instance Functor (Parser t) where
  fmap = liftM

instance Applicative (Parser t) where
  pure = return
  (<*>) = ap

instance Monad (Parser t) where
  return = lift
  (>>=)  = bind


-- derived parsers

sat :: (t -> Bool) -> Parser t t
sat p = token $ \t -> if p t then Just t else Nothing

anyToken :: Parser t t
anyToken = sat (const True)

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

letter :: Parser Char Char
letter = oneof (['a'..'z']++['A'..'Z'])

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

oneof :: Eq t => [t] -> Parser t t
oneof ts = sat (`elem` ts)

noneof :: Eq t => [t] -> Parser t t
noneof ts = sat (`notElem` ts)

space :: Parser Char Char
space = oneof " \n\r\t"

spaces :: Parser Char ()
spaces = many space >> return ()

string :: String -> Parser Char ()
string [] = return ()
string (x:xs) = char x >> string xs


-- derived combinators

many :: Parser t a -> Parser t [a]
many p = do { x <- p; xs <- many p; return (x:xs) } <|> return []

many1 :: Parser t a -> Parser t [a]
many1 p = do { x <- p; xs <- many p; return (x:xs) }

manyTill :: Parser t a -> Parser t b -> Parser t [a]
manyTill p e = (e >> return []) <|> do { x <- p; xs <- manyTill p e; return (x:xs) }

between :: Parser t a -> Parser t b -> Parser t c -> Parser t c
between l r p = l >> p >>= \x -> r >> return x


-- running parsers on input

parse :: Parser t a -> [t] -> Maybe a
parse p ts = case run p ts of
  Just (x, _) -> Just x
  Nothing     -> Nothing

test :: Parser t a -> [t] -> a
test p ts = case parse p ts of
  Just x -> x
  Nothing -> error "Parse.test: parse error"