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.Applicative ((<$>))
import Control.Exception
import Control.Monad.Trans.Class
import qualified Data.ByteString as B
import Data.Monoid
import Data.Word (Word8)
mapChunksPT :: (NullPoint s) => (s -> s') -> Enumeratee s s' m a
mapChunksPT f = eneeCheckIfDonePass (icont . step)
where
step k (Chunk xs) = eneeCheckIfDonePass (icont . step) . k . Chunk $ f xs
step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ EOF mErr
mapChunksMPT
:: (Monad m, NullPoint s, Nullable s)
=> (s -> m s')
-> Enumeratee s s' m a
mapChunksMPT f = eneeCheckIfDonePass (icont . step)
where
step k (Chunk xs) = lift (f xs) >>=
eneeCheckIfDonePass (icont . step) . k . Chunk
step k (EOF mErr) = eneeCheckIfDonePass (icont . step) . k $ 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 (Just e) = throwRecoverableErr e (const identity)
>> go (k $ Chunk empty)
check k _ = isStreamFinished >>= maybe (step k)
(\e -> case fromException e of
Just EofException -> go . k $ EOF Nothing
Nothing -> go . k . EOF $ Just e)
step k = fi >>= go . k . Chunk
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 (Just e) = throwRecoverableErr e (const identity)
>> go acc (k $ Chunk empty)
check acc k _ = isStreamFinished >>= maybe (step acc k)
(\e -> case fromException e of
Just EofException -> go acc . k $ EOF Nothing
Nothing -> go acc . k . EOF $ Just e)
step acc k = f acc >>= \(acc', s') -> go acc' . k $ Chunk s'
unfoldConvStreamCheckPT
:: (Monad m, Nullable elo)
=> (((Stream eli -> Iteratee eli m a)
-> Maybe SomeException
-> 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 = checkDone (check acc0)
where
check acc k mX = step acc k mX
step acc k Nothing = f acc >>= \(acc', s') ->
(checkDone (check acc') . k $ Chunk s')
step acc k (Just ex) = throwRecoverableErr ex $ \str' ->
let i = f acc >>= \(acc', s') ->
(checkDone (check acc') . k $ Chunk s')
in joinIM $ enumChunk str' i
breakEPT
:: (LL.ListLike s el, NullPoint s)
=> (el -> Bool)
-> Enumeratee s s m a
breakEPT cpred = eneeCheckIfDonePass (icont . step)
where
step k (Chunk s)
| LL.null s = liftI (step k)
| otherwise = case LL.break cpred s of
(str', tail')
| LL.null tail' -> eneeCheckIfDonePass (icont . step) . k $ Chunk str'
| otherwise -> idone (k $ Chunk str') (Chunk tail')
step k stream = idone (k stream) stream
takePT ::
(Monad m, Nullable s, LL.ListLike s el)
=> Int
-> Enumeratee s s m a
takePT n' iter
| n' <= 0 = return iter
| otherwise = Iteratee $ \od oc -> runIter iter (on_done od oc) (on_cont od oc)
where
on_done od oc x _ = runIter (drop n' >> return (return x)) od oc
on_cont od oc k Nothing = if n' == 0 then od (liftI k) (Chunk mempty)
else runIter (liftI (step n' k)) od oc
on_cont od oc _ (Just e) = runIter (drop n' >> throwErr e) od oc
step n k (Chunk str)
| LL.null str = liftI (step n k)
| LL.length str <= n = takePT (n LL.length str) $ k (Chunk str)
| otherwise = idone (k (Chunk s1)) (Chunk s2)
where (s1, s2) = LL.splitAt n str
step _n k stream = idone (k stream) stream
takeUpToPT :: (Monad m, Nullable s, LL.ListLike s el) => Int -> Enumeratee s s m a
takeUpToPT i iter
| i <= 0 = idone iter (Chunk empty)
| otherwise = Iteratee $ \od oc ->
runIter iter (onDone od oc) (onCont od oc)
where
onDone od oc x str = runIter (idone (return x) str) od oc
onCont od oc k Nothing = if i == 0 then od (liftI k) (Chunk mempty)
else runIter (liftI (step i k)) od oc
onCont od oc _ (Just e) = runIter (throwErr e) od oc
step n k (Chunk str)
| LL.null str = liftI (step n k)
| LL.length str < n = takeUpToPT (n LL.length str) $ k (Chunk str)
| otherwise =
let (s1, s2) = LL.splitAt n str
in Iteratee $ \od' _ -> do
res <- runIter (k (Chunk s1)) (\a s -> return $ Left (a, s))
(\k' e -> return $ Right (k',e))
case res of
Left (a,Chunk s1') -> od' (return a)
(Chunk $ s1' `LL.append` s2)
Left (a,s') -> od' (idone a s') (Chunk s2)
Right (k',e) -> od' (icont k' e) (Chunk s2)
step _ k stream = idone (k stream) stream
takeWhileEPT
:: (LL.ListLike s el, NullPoint s)
=> (el -> Bool)
-> Enumeratee s s m a
takeWhileEPT = breakEPT . (not .)
mapStreamPT
:: (LL.ListLike (s el) el
,LL.ListLike (s el') el'
,NullPoint (s el)
,LooseMap s el el')
=> (el -> el')
-> Enumeratee (s el) (s el') m a
mapStreamPT f = mapChunksPT (lMap f)
rigidMapStreamPT
:: (LL.ListLike s el, NullPoint s)
=> (el -> el)
-> Enumeratee s s m a
rigidMapStreamPT f = mapChunksPT (LL.rigidMap f)
filterPT
:: (Monad m, Functor m, Nullable s, LL.ListLike s el)
=> (el -> Bool)
-> Enumeratee s s m a
filterPT p = convStreamPT (LL.filter p <$> getChunk)