--  The parser monad
--
--  Author: Robin Cockett
--  Date: 4 April 2002

----------------------------------------------------------------------

newtype Parser a = MkP (String -> [(a,String)])

apply:: Parser a -> String -> [(a,String)]
apply (MkP f) s = f s

instance Monad Parser where
    return x = MkP f where f s = [(x,s)]
    p >>= q  = MkP f where 
          f s = [(y,s'') | (x,s') <- apply p s, (y,s'') <- apply (q x) s']

--
--  Basic parsers
--

-- Getting a character
get_ch :: Parser Char
get_ch = MkP f where f [] = []
                     f (c:cs) = [(c,cs)]

-- The parser which always fails
failP :: Parser a
failP = MkP f where f s = []


-- Getting a digit
get_digit :: Parser Int
get_digit = ( do { c <- get_ch ;
                   if is_digit c then return (ord c - ord '0') 
                                 else failP } ) where
                      is_digit c = (c >= '0'  &&  '9' >= c)

-- Eating up a given character
char:: Char -> Parser ()
char x = do c <- get_ch
            if c==x then return () else failP

----------------------------------------------------------------
--  Combining parsers
--
--  Try one parser then the next

( // ):: Parser a -> Parser a -> Parser a
p // q = MkP f where 
            f s = if null ps then apply q s else ps where
                   ps = apply p s

-- The Kleene star
star:: Parser a -> Parser [a]
star p = ( do x  <- p
              xs <- star p
              return (x:xs)
         ) // return []


---------------------------------------------------------------
-- EXAMPLE:
-- parsing a comma separated list of integers
--

-- parsing a natural number in decimal
nat :: Parser Int
nat = do d  <- get_digit
         ds <- star get_digit
         return ( foldl (\d -> (\ds -> (10*d+ds))) 0 (d:ds))

-- parsing integers
int :: Parser Int
int = (do sign <- op
          n <- nat
          return (sign n)) where
            op = (do s <- char '-'
                     return (\n -> -n))// return (\n -> n)

-- eating spaces
space :: Parser ()
space = do sp <- star (char ' ')
           return ()


-- the parser for lists of integers
ints :: Parser [Int]
ints = do space
          char '['
          space
          x <- int
          xs <- star (do {space; char ','; space ; int})
          space
          char ']'
          return (x:xs)