Combinator.hs

module Text.Derp.Combinator
 ( (<~), (~>)
 , count, between, option, optionMaybe
 , many, many1, skipMany, skipMany1
 , sepBy, sepBy1, endBy, endBy1, endSepBy, endSepBy1, manyTill
 ) where
import Text.Derp -- hiding (xsR, xsL, xsIn, parens, parensIn
                 --        , amb, ambIn, sexp, sexpIn
                 --        )

-- import qualified Data.Set as S

tok s = Token s s

infixr 4 <~
infixl 4 ~>
a <~ b = a <~> b ==> fst
a ~> b = a <~> b ==> snd

-- choice

count :: Ord a => Int -> Parser a -> Parser [a]
count n p | n > 0     = p <~> count (n-1) p ==> uncurry (:)
          | otherwise = eps []

-- runParse (count 2 (ter "a")) (map tok ["a","a"]) == S.fromList [["a","a"]]

between :: (Ord open, Ord close, Ord a) =>
           Parser open -> Parser close -> Parser a -> Parser a
between open close p = open ~> (p <~ close)

-- runParse (between (ter "(") (ter ")") (many1 $ ter "a")) (map tok ["(","a","a",")"]) == S.fromList [["a","a"]]

option :: Ord a => a -> Parser a -> Parser a
option a p = eps a <|> p

optionMaybe :: Ord a => Parser a -> Parser (Maybe a)
optionMaybe p = eps Nothing <|> (p ==> Just)

-- optional -- what would this even mean?

many, many1 :: Ord a => Parser a -> Parser [a]
many p = eps [] <|> many1 p
many1 p = p <~> many p ==> uncurry (:)

skipMany, skipMany1 :: Ord a => Parser a -> Parser ()
skipMany p = eps () <|> skipMany1 p
skipMany1 p = p ~> skipMany p

sepBy, sepBy1 :: (Ord a, Ord sep) => Parser a -> Parser sep -> Parser [a]
sepBy p sep = eps [] <|> sepBy1 p sep
sepBy1 p sep = p <~> option [] (sep ~> sepBy1 p sep) ==> uncurry (:)

endBy, endBy1 :: (Ord a, Ord sep) => Parser a -> Parser sep -> Parser [a]
endBy p sep = eps [] <|> endBy1 p sep
endBy1 p sep = (p <~ sep) <~> endBy p sep ==> uncurry (:)

endSepBy, endSepBy1 :: (Ord a, Ord sep) => Parser a -> Parser sep -> Parser [a]
endSepBy p sep = eps [] <|> endSepBy1 p sep
endSepBy1 p sep = sepBy1 p sep <~ optionMaybe sep

manyTill :: (Ord a, Ord end) => Parser a -> Parser end -> Parser [a]
manyTill p end = many p <~ end

-- chainl
-- chainr
-- chainl1
-- chainr1
-- eof
-- lookAhead -- this is not meaningul in derp
-- anyToken