module Data.Iteratee.PTerm (
mapChunksPT
,mapChunksMPT
,convStreamPT
,unfoldConvStreamPT
,unfoldConvStreamCheckPT
,breakEPT
,takePT
,takeUpToPT
,takeWhileEPT
,mapStreamPT
,rigidMapStreamPT
,filterPT
)
where
import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)
import Data.Iteratee.Iteratee
import Data.Iteratee.ListLike (drop)
import qualified Data.ListLike as LL
import Control.Arrow ((***), first)
import Control.Monad.Trans.Class
import Control.Monad
import qualified Data.ByteString as B
import Data.Monoid
import Data.Word (Word8)
(<$>) :: Monad m => (a1 -> r) -> m a1 -> m r
(<$>) = liftM
mapChunksPT :: (NullPoint s, Monad m) => (s -> s') -> Enumeratee s s' m a
mapChunksPT f = go
where
go = eneeCheckIfDonePass (icont . step)
step k (Chunk xs) = k (Chunk (f xs)) >>= \(i',_) ->
return (go i', Chunk empty)
step k (EOF mErr) = k (EOF mErr) >>= (\(i',_) ->
return (go i' , EOF mErr))
mapChunksMPT
:: (Monad m, NullPoint s, Nullable s)
=> (s -> m s')
-> Enumeratee s s' m a
mapChunksMPT f = go
where
go = eneeCheckIfDonePass (icont . step)
step k (Chunk xs) = f xs >>= k . Chunk >>= \(i', _str) ->
return (go i', Chunk empty)
step k (EOF mErr) = k (EOF mErr) >>= \(i',_) ->
return (go i', EOF mErr)
convStreamPT
:: (Monad m, Nullable s, NullPoint s')
=> Iteratee s m s'
-> Enumeratee s s' m a
convStreamPT fi = go
where
go = eneeCheckIfDonePass check
check k = isStreamFinished >>= maybe (step k)
(\e -> case fromException e of
Just EofException -> lift (k (EOF Nothing)) >>= go . fst
Nothing -> lift (k (EOF (Just e))) >>= go . fst)
step k = fi >>= lift . k . Chunk >>= go . fst
unfoldConvStreamPT ::
(Monad m, Nullable s, NullPoint s') =>
(acc -> Iteratee s m (acc, s'))
-> acc
-> Enumeratee s s' m a
unfoldConvStreamPT f acc0 = go acc0
where
go acc = eneeCheckIfDonePass (check acc)
check acc k = isStreamFinished >>= maybe (step acc k)
(\e -> case fromException e of
Just EofException -> lift (k (EOF Nothing))
>>= go acc . fst
Nothing -> lift (k (EOF (Just e)))
>>= go acc . fst )
step acc k = f acc
>>= \(acc',s') -> lift (k (Chunk s'))
>>= go acc' . fst
unfoldConvStreamCheckPT
:: (Monad m, Nullable elo)
=> ((Cont eli m a -> Iteratee elo m (Iteratee eli m a))
-> Enumeratee elo eli m a
)
-> (acc -> Iteratee elo m (acc, eli))
-> acc
-> Enumeratee elo eli m a
unfoldConvStreamCheckPT checkDone f acc0 = go acc0
where
go acc = checkDone (check acc)
check acc k = isStreamFinished >>= maybe (step acc k)
(\e -> case fromException e of
Just EofException -> lift (k (EOF Nothing))
>>= go acc . fst
Nothing -> lift (k (EOF (Just e))) >>= go acc . fst )
step acc k = do
(acc',s') <- f acc
lift (k (Chunk s')) >>= go acc' . fst
breakEPT
:: (LL.ListLike s el, NullPoint s, Monad m)
=> (el -> Bool)
-> Enumeratee s s m a
breakEPT cpred = go
where
go = eneeCheckIfDonePass (icont . step)
step k s'@(Chunk s)
| LL.null s = return (icont (step k), s')
| otherwise = case LL.break cpred s of
(str', tail')
| LL.null tail' -> (go *** const mempty) <$> k (Chunk str')
| otherwise -> (idone *** const (Chunk tail')) <$> k (Chunk str')
step k stream = (idone *** const stream) <$> k stream
takePT ::
(Monad m, Nullable s, LL.ListLike s el)
=> Int
-> Enumeratee s s m a
takePT n' iter
| n' <= 0 = return iter
| otherwise = runIter iter onDone onCont onErr onReq
where
onDone x = drop n' >> idone (idone x)
onCont k = if n' == 0 then idone (icont k)
else icont (step n' k)
onErr i = ierr (takePT n' i)
onReq mb doB = ireq mb (takePT n' . doB)
step n k c@(Chunk str)
| LL.null str = return (icont (step n k), c)
| LL.length str <= n = (takePT (n LL.length str) *** const mempty)
<$> k (Chunk str)
| otherwise = (idone *** const (Chunk s2)) <$> k (Chunk s1)
where (s1, s2) = LL.splitAt n str
step _n k stream = (idone *** const stream) <$> k stream
takeUpToPT :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a
takeUpToPT i iter
| i <= 0 = idone iter
| otherwise = runIter iter onDone onCont onErr onReq
where
onDone x = idone (idone x)
onCont k = if i == 0 then idone (icont k)
else icont (step i k)
onErr i' = ierr (takeUpToPT i i')
onReq mb doB = ireq mb (takeUpToPT i . doB)
step n k c@(Chunk str)
| LL.null str = return (icont (step n k), c)
| LL.length str < n = first (takeUpToPT (n LL.length str))
<$> k (Chunk str)
| otherwise = do
let (s1, s2) = LL.splitAt n str
(iter', preStr) <- k (Chunk s1)
case preStr of
(Chunk preC)
| LL.null preC -> return (idone iter', Chunk s2)
| otherwise -> return (idone iter'
, Chunk $ preC `LL.append` s2)
_ -> return (idone iter', preStr)
step _ k stream = (idone *** const stream) <$> k stream
takeWhileEPT
:: (LL.ListLike s el, NullPoint s, Monad m)
=> (el -> Bool)
-> Enumeratee s s m a
takeWhileEPT = breakEPT . (not .)
mapStreamPT
:: (LL.ListLike (s el) el
,LL.ListLike (s el') el'
,NullPoint (s el)
,Monad m
,LooseMap s el el')
=> (el -> el')
-> Enumeratee (s el) (s el') m a
mapStreamPT f = mapChunksPT (lMap f)
rigidMapStreamPT
:: (LL.ListLike s el, Monad m, NullPoint s)
=> (el -> el)
-> Enumeratee s s m a
rigidMapStreamPT f = mapChunksPT (LL.rigidMap f)
filterPT
:: (Monad m, Nullable s, LL.ListLike s el)
=> (el -> Bool)
-> Enumeratee s s m a
filterPT p = convStreamPT (LL.filter p <$> getChunk)