module Parser where

import Data.Char

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


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

-- Simple parsers:

one :: (Char -> Bool) -> Parser Char
one pred (x:xs) = if pred x then [(x,xs)] else []
one _ [] = []

char :: Char -> Parser Char
char c = one (== c)

success :: a -> Parser a
success a xs = [(a,xs)]

-- 
-- Combining parsers						
--
  
--  
-- p1 ||| p2 recognises anything recognised by p1 orelse by p2
--  
(|||) :: Parser a -> Parser a -> Parser a
p1 ||| p2 = \cs -> p1 cs ++ p2 cs


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

(***) :: Parser a -> Parser b -> Parser (a,b)
(p1 *** p2) xs = [((a,b),zs) | (a,ys) <- p1 xs, (b,zs) <- p2 ys]

-- 
-- Transform the result of the parser by the function.
--  
(>>>) :: Parser a -> (a -> b) -> Parser b
p >>> f  =  \xs -> [(f a,ys) | (a,ys) <- p xs]

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

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

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

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

-- unsigned integer
uint :: Parser Integer
uint = list1(one isDigit) >>> read

-- Handling spaces

spaces :: Parser String
spaces  =  list (one isSpace)

token :: Parser a -> Parser a
token p  =  spaces *** p >>> snd

symb :: Char -> Parser Char
symb c  =  token (char c)

-- Parse to the end
total :: Parser a -> String -> [a]
total p xs = [a | (a,ys) <- p xs, all isSpace ys]