module Parser where

import Data.Char

infixr 5 ***
infixr 4 >>>
infixr 3 |||

--
-- The type of parsers.
--
type Parser a b = [a] -> Maybe(b,[a])

success b xs = Just(b,xs)

one :: (a -> Bool) -> Parser a a
one pred (a:as) = if pred a then Just(a,as) else Nothing
one _ [] = Nothing

item :: Eq a => a -> Parser a a
item a = one (== a)

--
-- Combining parsers
--

--
-- p1 ||| p2 recognises anything recognised by p1 orelse by p2
--
(|||) :: Parser a b -> Parser a b -> Parser a b
p1 ||| p2 = \as -> case p1 as of
                     Nothing -> p2 as
                     just -> just

--
-- Apply one parser then the second to the result(s) of the first.
--

(***) :: Parser a b -> Parser a c -> Parser a (b,c)
p1 *** p2 = \xs ->
  case p1 xs of
    Nothing -> Nothing
    Just(b,ys) -> case p2 ys of
                    Nothing -> Nothing
                    Just(c,zs) -> Just((b,c),zs)

{- For friends of Monad, here are more compact versions of ***:
p1 *** p2 = \xs -> p1 xs >>= \(b,ys) -> p2 ys >>= \(c,zs) -> Just((b,c),zs)
p1 *** p2 = \xs ->
  do (b,ys) <- p1 xs
     (c,zs) <- p2 ys
     return ((b,c),zs)
-}

--
-- Transform the result of the parser by the function.
--
(>>>) :: Parser a b -> (b -> c) -> Parser a c
p >>> f  =  \xs ->
  case p xs of
    Nothing -> Nothing
    Just(b, ys) -> Just(f b, ys)

--
-- Recognise a list of objects.
--
--
list :: Parser a b -> Parser a [b]
list p  =  p *** list p >>> uncurry (:)  |||  success []

-- A non-empty list of objects.
--
list1   :: Parser a b -> Parser a [b]
list1 p = p *** list p >>> uncurry (:)

-- Zero or one object.
optional :: Parser a b -> Parser a (Maybe b)
optional p  =  p >>> Just  |||  success Nothing

-- Alphanumeric identifiers
identifier :: Parser Char String
identifier = list1(one isAlpha) *** list(one isDigit) >>> uncurry (++)

-- Enclose in items
enclose :: Eq a => a -> a -> Parser a b -> Parser a b
enclose l r p  =  item l *** p *** item r >>> \ (_,(b,_)) -> b