module Data.Iteratee.Iteratee (
throwErr
,throwRecoverableErr
,checkErr
,identity
,skipToEof
,isStreamFinished
,mapChunksM_
,mapReduce
,getChunk
,getChunks
,mapChunks
,convStream
,unfoldConvStream
,joinI
,joinIM
,Enumerator
,Enumeratee
,enumChunk
,enumEof
,enumErr
,enumPure1Chunk
,enumList
,enumCheckIfDone
,enumFromCallback
,enumFromCallbackCatch
,(>>>)
,eneeCheckIfDone
,mergeEnums
,(><>)
,(<><)
,seek
,FileOffset
,module Data.Iteratee.Base
)
where
import Prelude hiding (head, drop, dropWhile, take, break, foldl, foldl1, length, filter, sum, product)
import Data.Iteratee.IO.Base
import Data.Iteratee.Base
import Control.Exception
import Control.Monad.Trans.Class
import Control.Parallel
import Data.Maybe
import Data.Monoid
import Data.Typeable
excDivergent :: SomeException
excDivergent = toException DivergentException
throwErr :: (Monad m) => SomeException -> Iteratee s m a
throwErr e = icont (const (throwErr e)) (Just e)
throwRecoverableErr ::
(Monad m) =>
SomeException
-> (Stream s -> Iteratee s m a)
-> Iteratee s m a
throwRecoverableErr e i = icont i (Just e)
checkErr ::
(Monad m, NullPoint s) =>
Iteratee s m a
-> Iteratee s m (Either SomeException a)
checkErr iter = Iteratee $ \onDone onCont ->
let od = onDone . Right
oc k Nothing = onCont (checkErr . k) Nothing
oc _ (Just e) = onDone (Left e) (Chunk empty)
in runIter iter od oc
identity :: (Monad m, NullPoint s) => Iteratee s m ()
identity = idone () (Chunk empty)
isStreamFinished :: (Monad m, Nullable s) => Iteratee s m (Maybe SomeException)
isStreamFinished = liftI check
where
check s@(Chunk xs)
| nullC xs = isStreamFinished
| otherwise = idone Nothing s
check s@(EOF e) = idone (Just $ fromMaybe (toException EofException) e) s
skipToEof :: (Monad m) => Iteratee s m ()
skipToEof = icont check Nothing
where
check (Chunk _) = skipToEof
check s = idone () s
seek :: (Monad m, NullPoint s) => FileOffset -> Iteratee s m ()
seek o = throwRecoverableErr (toException $ SeekException o) (const identity)
mapChunksM_ :: (Monad m, Nullable s) => (s -> m b) -> Iteratee s m ()
mapChunksM_ f = liftI step
where
step (Chunk xs)
| nullC xs = liftI step
| otherwise = lift (f xs) >> liftI step
step s@(EOF _) = idone () s
mapReduce ::
(Monad m, Nullable s, Monoid b)
=> Int
-> (s -> b)
-> Iteratee s m b
mapReduce bufsize f = liftI (step (0, []))
where
step a@(!buf,acc) (Chunk xs)
| nullC xs = liftI (step a)
| buf >= bufsize =
let acc' = mconcat acc
b' = f xs
in b' `par` acc' `pseq` liftI (step (0,[b' `mappend` acc']))
| otherwise =
let b' = f xs
in b' `par` liftI (step (succ buf,b':acc))
step (_,acc) s@(EOF Nothing) =
idone (mconcat acc) s
step acc (EOF (Just err)) =
throwRecoverableErr err (step acc)
getChunk :: (Monad m, Nullable s, NullPoint s) => Iteratee s m s
getChunk = liftI step
where
step (Chunk xs)
| nullC xs = liftI step
| otherwise = idone xs $ Chunk empty
step (EOF Nothing) = throwErr $ toException EofException
step (EOF (Just e)) = throwErr e
getChunks :: (Monad m, Nullable s) => Iteratee s m [s]
getChunks = liftI (step [])
where
step acc (Chunk xs)
| nullC xs = liftI (step acc)
| otherwise = liftI (step (xs:acc))
step acc stream = idone (reverse acc) stream
type Enumeratee sFrom sTo (m :: * -> *) a =
Iteratee sTo m a
-> Iteratee sFrom m (Iteratee sTo m a)
eneeCheckIfDone ::
(Monad m, NullPoint elo) =>
((Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a))
-> Enumeratee elo eli m a
eneeCheckIfDone f inner = Iteratee $ \od oc ->
let onDone x s = od (idone x s) (Chunk empty)
onCont k Nothing = runIter (f k) od oc
onCont _ (Just e) = runIter (throwErr e) od oc
in runIter inner onDone onCont
mapChunks :: (Monad m, NullPoint s) => (s -> s') -> Enumeratee s s' m a
mapChunks f = eneeCheckIfDone (liftI . step)
where
step k (Chunk xs) = eneeCheckIfDone (liftI . step) . k . Chunk $ f xs
step k str@(EOF mErr) = idone (k $ EOF mErr) str
convStream ::
(Monad m, Nullable s) =>
Iteratee s m s'
-> Enumeratee s s' m a
convStream fi = eneeCheckIfDone check
where
check k = isStreamFinished >>= maybe (step k) (idone (liftI k) . EOF . Just)
step k = fi >>= eneeCheckIfDone check . k . Chunk
unfoldConvStream ::
(Monad m, Nullable s) =>
(acc -> Iteratee s m (acc, s'))
-> acc
-> Enumeratee s s' m a
unfoldConvStream f acc0 = eneeCheckIfDone (check acc0)
where
check acc k = isStreamFinished >>=
maybe (step acc k) (idone (liftI k) . EOF . Just)
step acc k = f acc >>= \(acc', s') ->
eneeCheckIfDone (check acc') . k . Chunk $ s'
joinI ::
(Monad m, Nullable s) =>
Iteratee s m (Iteratee s' m a)
-> Iteratee s m a
joinI = (>>=
\inner -> Iteratee $ \od oc ->
let onDone x _ = od x (Chunk empty)
onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont'
onCont _ (Just e) = runIter (throwErr e) od oc
onCont' _ e = runIter (throwErr (fromMaybe excDivergent e)) od oc
in runIter inner onDone onCont)
joinIM :: (Monad m) => m (Iteratee s m a) -> Iteratee s m a
joinIM mIter = Iteratee $ \od oc -> mIter >>= \iter -> runIter iter od oc
type Enumerator s m a = Iteratee s m a -> m (Iteratee s m a)
enumChunk :: (Monad m) => Stream s -> Enumerator s m a
enumChunk (Chunk xs) = enumPure1Chunk xs
enumChunk (EOF Nothing) = enumEof
enumChunk (EOF (Just e)) = enumErr e
enumEof :: (Monad m) => Enumerator s m a
enumEof iter = runIter iter onDone onCont
where
onDone x _str = return $ idone x (EOF Nothing)
onCont k Nothing = runIter (k (EOF Nothing)) onDone onCont'
onCont k e = return $ icont k e
onCont' _ Nothing = return $ throwErr excDivergent
onCont' k e = return $ icont k e
enumErr :: (Exception e, Monad m) => e -> Enumerator s m a
enumErr e iter = runIter iter onDone onCont
where
onDone x _ = return $ idone x (EOF . Just $ toException e)
onCont k Nothing = runIter (k (EOF (Just (toException e)))) onDone onCont'
onCont k e' = return $ icont k e'
onCont' _ Nothing = return $ throwErr excDivergent
onCont' k e' = return $ icont k e'
(>>>) :: (Monad m) => Enumerator s m a -> Enumerator s m a -> Enumerator s m a
(e1 >>> e2) i = e1 i >>= e2
(><>) ::
(Nullable s1, Monad m)
=> (forall x . Enumeratee s1 s2 m x)
-> Enumeratee s2 s3 m a
-> Enumeratee s1 s3 m a
f ><> g = joinI . f . g
(<><) ::
(Nullable s1, Monad m)
=> Enumeratee s2 s3 m a
-> (forall x. Enumeratee s1 s2 m x)
-> Enumeratee s1 s3 m a
f <>< g = joinI . g . f
mergeEnums ::
(Nullable s2, Nullable s1, Monad m)
=> Enumerator s1 m a
-> Enumerator s2 (Iteratee s1 m) a
-> Enumeratee s2 s1 (Iteratee s1 m) a
-> Enumerator s1 m a
mergeEnums e1 e2 etee i = e1 $ e2 (joinI . etee $ ilift lift i) >>= run
enumPure1Chunk :: (Monad m) => s -> Enumerator s m a
enumPure1Chunk str iter = runIter iter idoneM onCont
where
onCont k Nothing = return $ k $ Chunk str
onCont k e = return $ icont k e
enumList :: (Monad m) => [s] -> Enumerator s m a
enumList chunks = go chunks
where
go [] i = return i
go xs' i = runIter i idoneM (onCont xs')
where
onCont (x:xs) k Nothing = go xs . k $ Chunk x
onCont _ _ (Just e) = return $ throwErr e
onCont _ k Nothing = return $ icont k Nothing
enumCheckIfDone :: (Monad m) => Iteratee s m a -> m (Bool, Iteratee s m a)
enumCheckIfDone iter = runIter iter onDone onCont
where
onDone x str = return (True, idone x str)
onCont k e = return (False, icont k e)
enumFromCallback ::
(Monad m, NullPoint s) =>
(st -> m (Either SomeException ((Bool, st), s)))
-> st
-> Enumerator s m a
enumFromCallback c st =
enumFromCallbackCatch c (\NotAnException -> return Nothing) st
data NotAnException = NotAnException
deriving (Show, Typeable)
instance Exception NotAnException where
instance IException NotAnException where
enumFromCallbackCatch ::
(IException e, Monad m, NullPoint s) =>
(st -> m (Either SomeException ((Bool, st), s)))
-> (e -> m (Maybe EnumException))
-> st
-> Enumerator s m a
enumFromCallbackCatch c handler = loop
where
loop st iter = runIter iter idoneM (onCont st)
onCont st k Nothing = c st >>=
either (return . k . EOF . Just) (uncurry check)
where
check (b,st') = if b then loop st' . k . Chunk else return . k . Chunk
onCont st k j@(Just e) = case fromException e of
Just e' -> handler e' >>= maybe (loop st . k $ Chunk empty)
(return . icont k . Just) . fmap toException
Nothing -> return (icont k j)