-- Monadic parser, implemented as a modified state
-- transformer.  A Parser carries a program that consumes
-- a prefix of the input string and delivers one or more
-- alternative results. Empty list occurs on failure.

module Parser(
	Parser,
	apply,
	zero,
	next, char, 
	string, nil,
	isPresent,
	plus, orelse,
	some, seplist
) where

infixl 1 `plus`, `orelse`	-- same precedence as >>=

-- A parser is a state transformer, where the state is the
-- unparsed tail of the input string.

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

-- The reason for newtype instead of simply "type Parser a" is
-- a restriction against type synonyms in Monad instances

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

-- Recall signatures of Monad functions
--	return :: a -> Parser a
--	(>>=) :: Parser a -> (a -> Parser b) -> Parser b
--	(>>) :: Parser a -> Parser b -> Parser b
--	p >> t = p >>= \_ t

instance Monad Parser where
	return v = Parser (\s -> [(v,s)])

	p >>= t = Parser f where {
	    f = \s->concat[apply (t v) s' | (v,s')<-apply p s] }

-- Some trivial parsers

zero :: Parser a
zero = Parser (\s -> [])	    -- always fails

nil :: Parser [a]
nil = return []

next :: Parser Char		    -- get one character
next = Parser (\s -> case s of
                     [] -> []
                     (c:cs) -> [(c,cs)])

-- Parse a character that satisfies predicate p

char :: (Char->Bool) -> Parser Char
char p = do { c<-next; if p c then return c else zero }

string :: String -> Parser ()
string (c:cs) = do 
                   char(==c)
                   if cs==[]
                      then return()
                      else string cs

-- COMBINATORS

-- Lookahead function tells what's next in the input without
-- advancing the scan

isPresent :: Parser a -> Parser Bool
isPresent p = Parser (\s -> [(not.null $ apply p s ,s)])

-- Alternation; does backtracking without special arrangements

plus :: Parser a -> Parser a -> Parser a
p `plus` q = Parser (\s -> apply p s ++ apply q s)

-- Alternation, taking second branch only if first fails

orelse :: Parser a -> Parser a -> Parser a
p `orelse` q = Parser (\s -> case apply p s of
                             [] -> apply q s
			     rs -> rs)

-- A maximal nonempty sequence of p's

some :: Parser a -> Parser [a]
some p = do
            x<-p
            xs<-some p `orelse` nil
            return (x:xs)

-- A maximal nomempty sequence of p's separated by q's

seplist :: Parser a -> Parser b -> Parser [a]
seplist p q = do
                 x<-p
                 xs<-(do {q; seplist p q}) `orelse` nil
                 return (x:xs)