import List
import Monad
import Char
import Lang

-- parser jako monada

data Parser a = P {unP :: String -> [(a, String)]}

instance Monad Parser where
  P p >>= f = P (\s -> concatMap appf (p s))
    where
      appf (a, rest) = unP (f a) rest
  return x = P (\s -> [(x, s)])
  fail _ = P (\_ -> [])

instance MonadPlus Parser where
  P p `mplus` P q = P (\s -> p s ++ q s)
  mzero = P (\_ -> [])

-- primitivni parsery

item::Parser Char
item = P item'
  where
   item' [] = []
   item' (h:t) = [(h,t)]

eof::Parser Bool
eof = P eof'
  where
   eof' [] = [(True,[])]
   eof' s = [(False,s)]

peek::Parser Char
peek = P peek'
  where
   peek' [] = []
   peek' (h : t) = [(h,(h:t))]

-- spusteni parsovani

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

onEof::a->Parser a
onEof x =
  do
    e <- eof
    if e then return x else mzero

sat::(Char->Bool)->Parser Char
sat pred =
  do
   x <- item
   if pred x then return x else mzero

char = sat isAlpha
digit = sat isDigit

word::Parser String
word = liftM2 (:) char word `mplus` return ""

wdig =
  do
    x <- word
    digit
    y <- wdig
    return (x++y)
  `mplus` onEof ""

test::Parser String->Int
test p = length $ fst $ head $ parse p $ concat $ replicate 10000 "aaaaaaaaaa5"

test1::Parser String->Int->Int
test1 p n = length $ parse p $ replicate n 'a'

-- test wdig -- (1.59 secs, 57 741 908 bytes)
-- test1 word 1000 (0.89 secs, 83 244 252 bytes)
-- test1 word 3000 (10.88 secs, 741 181 380 bytes)