import Monad
import Char

-- parser, s presnejsi kontrolou nad tim, co se deje
-- typ P s a -- z retezce prvku typu s parsuj prvek typu a

-- primitivni operace:
-- symbol :: P s s
-- eof :: P s ()
-- mzero :: P s a
-- mplus :: P s a -> P s a -> P s a
-- >>= :: P s a -> (a -> P s b) -> P s b
-- return :: a -> P s a

-- semantika:

-- [symbol] (c:s) = {(c,s)}
-- [symbol] [] = {}
-- [eof] (_:_) = {}
-- [eof] [] = {((),[])}
-- [fail] s = {}
-- [p `mplus` q] s = [p] s \cup [q] s
-- [return x] s = {(x,s)}
-- [p >>= f] s = {(y,s'') | (x, s') \in [p] s, (y,s'') \in [f x] s}

-- symbol a eof se nehodi do typu pro parser, misto nej pouzijeme
-- symbolMap::(s->a)->P s a
-- [symbolMap h] (c:s) = {(h c, s)}
-- [symbolMap h] [] = {}
-- onEof::a->P s a
-- [onEof _] (_:_) = {}
-- [onEof x] [] = {(x,[])}

symbol::P s s
symbol = symbolMap id

eof::P s ()
eof = onEof ()

-- trivialni implementace:

data P s a = SymbolMap (s->a)
             | OnEof a
             | Fail
             | P s a :++ P s a
             | forall b . P s b :>>= (b->P s a)
             | Return a

symbolMap = SymbolMap
onEof = OnEof

instance Monad (P s) where
  p >>= f = p :>>= f
  return x = Return x

instance MonadPlus (P s) where
  mplus a b = a :++ b
  mzero = Fail

parse::P s a -> [s]->[(a,[s])]
parse (SymbolMap _) [] = []
parse (SymbolMap f) (c:s) = [(f c,s)]
parse (OnEof x) [] = [(x,[])]
parse (OnEof _) (_:_) = []
parse Fail _ = []
parse (p :++ q) s = parse p s ++ parse q s
parse (Return x) s = [(x,s)]
parse (p :>>= f) s = [(y,s'') | (x, s') <- parse p s, (y,s'') <- parse (f x) s']

-- neefektivni:
-- :++ pouziva ++, a pokud je levy operand dlouhy, muze byt neefektivni
-- :>>= vytvari pomocne seznamy