module ParseHelper where

import ParseDecorate

-- EBNF parser combinators 

option      :: Parser s a w -> a -> Parser s a w
option p d  =  p <|> succeed d

many    :: Parser s a w  -> Parser s [a] w
many p  =  (:) <$> p <*> many p <|> succeed []

many1    :: Parser s a w -> Parser s [a] w
many1 p  =  (:) <$> p <*> many p

pack        :: Parser s a w -> Parser s b w -> Parser s c w -> Parser s b w
pack p r q  =  (\_ x _ -> x) <$> p <*> r <*> q 

listOf      :: Parser s a w -> Parser s b w -> Parser s [a] w
listOf p s  =  (:) <$> p <*> many ((\_ x -> x) <$> s <*> p)

-- Chain expression combinators

chainr  ::  Parser s a w -> Parser s (a -> a -> a) w -> Parser s a w
chainr pe po  =  h <$> many (j <$> pe <*> po) <*> pe
  where j x op  =  (x `op`)
        h fs x  =  foldr ($) x fs

chainl  ::  Parser s a w -> Parser s (a -> a -> a) w -> Parser s a w
chainl pe po  =  h <$> pe <*> many (j <$> po <*> pe)
  where j op x  =  (`op` x)
        h x fs  =  foldl (flip ($)) x fs

parenthesised p  =  pack (symbol '(') p (symbol ')')

choice  :: [Parser s a w] -> Parser s a w
choice  =  foldr (<|>) failp

oneOf :: Eq s => [s] -> Parser s s w
oneOf = choice . map symbol


{-
-- Auxiliary functions

determ  ::  Parser s b -> Parser s b
determ p xs  |  null r     =  []
             |  otherwise  =  [head r]
  where r = p xs

greedy, greedy1  ::  Parser s b -> Parser s [b]
greedy   =  determ . many
greedy1  =  determ . many1

list x xs  =  x:xs


-- Applications of EBNF combinators

natural  :: Parser Char Int
natural  =  foldl (\a b -> a*10 + b) 0 <$> many1 digit

integer  ::  Parser Char Int
integer  =  (const negate <$> (symbol '-')) `option` id  <*>  natural 

identifier :: Parser Char String
identifier =  list <$> satisfy isAlpha <*> greedy (satisfy isAlphaNum)


commaList    :: Parser Char a -> Parser Char [a]
commaList p  =  listOf p (symbol ',')



-- Combinators for repetition (exercise 3.23)

psequence         :: [Parser s a w] -> Parser s [a]
psequence []      =  succeed []
psequence (p:ps)  =  list <$> p <*> psequence ps

psequence'  :: [Parser s a w] -> Parser s [a]
psequence'  =  foldr f (succeed [])
  where  f p q = list <$> p <*> q

-}