module ParseHelper where

import ParseDecorate
import Data.Char

-- EBNF parser combinators 

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

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

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

pack        :: Parser s a -> Parser s b -> Parser s c -> Parser s b
pack p r q  =  pi32 <$> p <*> r <*> q 

listOf      :: Parser s a -> Parser s b -> Parser s [a]
listOf p s  =  (:) <$> p <*> many (pi22 <$> s <*> p)

pi22 x y    =  y
pi32 x y z  =  y

-- Chain expression combinators

chainr  ::  Parser s a -> Parser s (a -> a -> a) -> Parser s a
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 -> Parser s (a -> a -> a) -> Parser s a
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 ')')


{-
-- 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] -> Parser s [a]
psequence []      =  succeed []
psequence (p:ps)  =  list <$> p <*> psequence ps

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

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