module Parse (none,succeed,token,spot,alt,(>*>),build,list,topLevel,Parse) where

infixr 5 >*>

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

none :: Parse a b
none inp = []

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

token :: Eq a => a -> Parse a a
token t (x:xs) 
  | t==x        = [(t,xs)]
  | otherwise   = []
token t []    = []

spot :: (a -> Bool) -> Parse a a
spot p (x:xs) 
  | p x         = [(x,xs)]
  | otherwise   = []
spot p []    = []

bracket = token '('
dig     =  spot isDigit

alt :: Parse a b -> Parse a b -> Parse a b
alt p1 p2 inp = p1 inp ++ p2 inp

exam1 = (bracket `alt` dig) "234"  -- ==> [('2',"34")]


(>*>) :: Parse a b -> Parse a c -> Parse a (b,c)

(>*>) p1 p2 inp 
  = [((y,z),rem2) | (y,rem1) <- p1 inp , (z,rem2)  <- p2 rem1 ]

twoDigits :: Parse Char (Char,Char)
twoDigits = (dig >*> dig) 

exam2 = twoDigits "123"  -- ==> [(('1','2'),"3")]


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

exam3 = build twoDigits readDigitPair "123"  -- ==> [(12,"3")]
  where readDigitPair (z,e) = read [z] * 10 + read [e]

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

digList = list dig

exam4 = digList "123"  -- ==> [("","123"),("1","23"),("12","3"),("123","")]

topLevel :: Parse a b -> [a] -> b
topLevel p inp
  = case results of
      [] -> error "parse unsuccessful"
      _  -> head results
    where
    results = [ found | (found,[]) <- p inp ]

exam5 = topLevel twoDigits "123" -- ==> Program error: parse unsuccessful
exam6 = topLevel twoDigits "12"  -- ==> ('1','2')
exam7 = topLevel digList "123"  -- ==> "123"