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

newtype Parser t a =
  Parser { run :: [t] -> Maybe (a, [t]) }

type CharP a = Parser Char a

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

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

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

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

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

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

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

letter :: CharP Char
letter = sat (`elem` (['a'..'z']++['A'..'Z']))

digit :: CharP Char
digit = sat (`elem` ['0'..'9'])

oneof :: String -> CharP Char
oneof cs = sat (`elem` cs)

noneof :: String -> CharP Char
noneof cs = sat (`notElem` cs)

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

spaces :: CharP ()
spaces = many space >> return ()

lift :: a -> Parser t a
lift x = Parser (\ts -> Just (x,ts))

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)

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

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)

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

followedBy :: Parser t a -> Parser t b -> Parser t a
p `followedBy` q = do {x <- p; q; return x}