module Data.ParserCombinators.Kangaroo.Combinators
(
manyTill
, genericManyTill
, manyTillPC
, genericManyTillPC
, count
, countPrefixed
, genericCount
, runOn
, genericRunOn
, postCheck
, buildWhile
, buildPrimitive
) where
import Data.ParserCombinators.Kangaroo.ParseMonad
import Data.ParserCombinators.Kangaroo.Utils
import Control.Applicative
import Data.Word
manyTill :: GenKangaroo ust a -> GenKangaroo ust b -> GenKangaroo ust [a]
manyTill = genericManyTill (:) []
genericManyTill :: (a -> c -> c) -> c
-> GenKangaroo ust a
-> GenKangaroo ust b
-> GenKangaroo ust c
genericManyTill op initial p end = opt end >>= \ans ->
case ans of
Just _ -> return initial
Nothing -> op <$> p <*> genericManyTill op initial p end
manyTillPC :: GenKangaroo ust a -> (a -> Bool) -> GenKangaroo ust ([a],a)
manyTillPC = genericManyTillPC (:) []
genericManyTillPC :: (a -> b -> b) -> b
-> GenKangaroo ust a
-> (a -> Bool)
-> GenKangaroo ust (b,a)
genericManyTillPC op initial p check = p >>= \ans ->
if check ans then do { (acc,end) <- genericManyTillPC op initial p check
; return (ans `op` acc,end)
}
else return (initial,ans)
count :: Int -> GenKangaroo ust a -> GenKangaroo ust [a]
count = genericCount (:) []
genericCount :: (a -> b -> b) -> b -> Int
-> GenKangaroo ust a
-> GenKangaroo ust b
genericCount op initial i p
| i <= 0 = pure initial
| otherwise = op <$> p <*> genericCount op initial (i1) p
countPrefixed :: Integral i
=> GenKangaroo ust i -> GenKangaroo ust a -> GenKangaroo ust (i,[a])
countPrefixed plen p = plen >>= \i ->
count (fromIntegral i) p >>= \ans -> return (i,ans)
runOn :: GenKangaroo ust a -> GenKangaroo ust [a]
runOn p = atEnd >>= \end -> if end then return [] else p <:> runOn p
genericRunOn :: (a -> b -> b) -> b -> GenKangaroo ust a -> GenKangaroo ust b
genericRunOn op initial p = atEnd >>= \end ->
if end then return initial else op <$> p <*> genericRunOn op initial p
postCheck :: GenKangaroo ust a -> (a -> Bool) -> String -> GenKangaroo ust a
postCheck p check msg = p >>= \ans ->
if check ans then return ans else reportError msg
buildWhile :: (a -> Bool)
-> (a -> b -> b)
-> (a -> b -> b)
-> b
-> GenKangaroo ust a
-> GenKangaroo ust b
buildWhile test op lastOp initial p = step where
step = p >>= \ans ->
if test ans then (step >>= \acc -> return $ ans `op` acc)
else (return $ ans `lastOp` initial)
buildPrimitive :: Int
-> (Word8 -> Bool)
-> (Word8 -> b -> b)
-> b
-> GenKangaroo ust b
buildPrimitive maxc check op initial | maxc <= 0 = return initial
| otherwise = step 0 initial
where
step i a | i >= maxc = return a
| otherwise = checkWord8 check >>= \ans -> case ans of
Nothing -> return a
Just x -> step (i+1) (x `op` a)