module Parser where

type Parse a b = [a]-> [(b, [a])]      

none :: Parse a b
none = const []

suceed :: b-> Parse a b
suceed b inp = [(b, inp)]

token :: Eq a=> a-> Parse a a
token t = spot (== t)
spot  :: (a-> Bool)-> Parse a a
spot p []     = []
spot p (x:xs) = if p x then [(x, xs)] else []

infixl 3 `alt`
alt :: Parse a b-> Parse a b-> Parse a b
alt p1 p2 i = p1 i ++ p2 i

infixl 5 >*>
(>*>) :: Parse a b-> Parse a c-> Parse a (b, c)
(>*>) p1 p2 i = [((y, z), r2) | (y, r1) <- p1 i, 
                                (z, r2) <- p2 r1]

infix 4 `build`
build :: Parse a b-> (b-> c)-> Parse a c
build p f inp = [(f x, r) | (x, r)<- p inp]    

infixl 5 *>, >*
(*>) :: Parse a b-> Parse a c-> Parse a c
(>*) :: Parse a b-> Parse a c-> Parse a b
p1 *> p2 = p1 >*> p2 `build` snd
p1 >* p2 = p1 >*> p2 `build` fst

list :: Parse a b-> Parse a [b]
list p = p >*> list p `build` uncurry (:)
         `alt` suceed []

some :: Parse a b-> Parse a [b]
some p = p >*> list p `build` uncurry (:)