ghost.hs

module Main where

import Control.Monad

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

parse (Parser p) = p

instance Monad Parser where
	return r = Parser (\s -> [(r, s)])
	p >>= q = Parser (\s -> concat [parse (q r) s' | (r, s') <- parse p s])

instance MonadPlus Parser where
	mzero = Parser (const [])
	mplus p q = Parser (\s -> parse p s ++ parse q s)

p >>> q = Parser (\s -> case parse (p `mplus` q) s of
	[] -> mzero
	(x : _) -> [x])

char = Parser (\s -> case s of
	[] -> mzero
	(c : cs) -> [(c, cs)])

charp p = do
	c <- char
	if p c
		then return c
		else mzero

rep p = (do
	c <- p
	cs <- rep p >>> return []
	return (c : cs)) >>> mzero

alt p q = (do
	a <- p
	as <- rep (q >> p) >>> return []
	return (a : as)) >>> mzero

eqp c c' = c == c'
letterp c = c >= 'a' && c <= 'z'
digitp d = d >= '0' && d <= '9'
whitespacep c = c == ' ' || c == '\t'

eq = charp . eqp
letter = charp letterp
digit = charp digitp
whitespace = charp whitespacep

word = rep letter

number :: (Read a, Num a) => Parser a
--number :: Parser Integer
number = liftM read $ rep digit

--data Op a = Add [Op a] | Sub [Op a] | Mul [Op a] | Div [Op a] | Val a
--	deriving Show

op = do
	c <- char
	case c of
		'+' -> return $ foldl1 (+)
		'-' -> return $ foldl1 (-)
		'*' -> return $ foldl1 (*)
		'/' -> return $ foldl1 (/)
		otherwise -> mzero

expr = (do
	eq '('
	op <- op
	rep whitespace
	par <- alt expr (rep whitespace)
	eq ')'
	return $ op par) >>> number