import Control.Monad
import Data.Char

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

parse :: (Parser a) -> (String -> [(a, String)])
parse (Parser p) = p

instance Monad Parser where
	 return a = Parser (\cs -> [(a, cs)])
	 p >>= f  = Parser (\cs -> concat [parse (f a) cs' | (a, cs') <- parse p cs])

instance MonadPlus Parser where
	mzero = Parser(\cs -> [])
	mplus p q = Parser (\cs -> (parse p cs) ++ (parse q cs))
	
(+++) :: Parser a -> Parser a -> Parser a 
p +++ q = Parser (\cs -> case (parse (p `mplus` q) cs) of
								[] -> []
								(x:xs) -> [x])
	 
item :: Parser Char
item = Parser (\cs -> case cs of 
						(c:nc) -> [(c, nc)]
						_ -> [])

sat :: (Char -> Bool) -> Parser Char
sat f = do { c <- item ; if f c then return c else mzero }

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

string :: String -> Parser String
string "" = return ""
string (c:cs) = do { x <- char c; xs <- string cs; return (x:xs) }

many :: Parser a -> Parser [a]
many p = many1 p +++ (return [])

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

chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op a = chainl1 p op +++ return a 

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
p `chainl1` op = do { a <- p; rest a}
	where rest a = do { f <- op; b <- p; rest (f a b) } +++ return a 
						
expr :: Parser Int
expr = term `chainl1` addop

term :: Parser Int
term = factor `chainl1` mulop

factor :: Parser Int
factor = digit +++ do { symb "("; n <- expr; symb ")"; return n }

symb :: String -> Parser String
symb cs = string cs

digit :: Parser Int
digit = do { x <- sat isDigit; return (ord x - ord '0') }

addop :: Parser (Int -> Int -> Int)
addop = do { symb "+"; return (+) } +++ do { symb "-"; return (-) }
mulop :: Parser (Int -> Int -> Int)
mulop = do { symb "*"; return (*) } +++ do { symb "/"; return div }