module Data.Iteratee.Iteratee (
throwErr
,throwRecoverableErr
,checkErr
,identity
,skipToEof
,isStreamFinished
,mapChunksM_
,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 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
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 id)
where
step acc (Chunk xs)
| nullC xs = liftI (step acc)
| otherwise = liftI (step $ acc . (xs:))
step acc stream = idone (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, Monoid s) => 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, Monoid s) => s -> Enumerator s m a
enumPure1Chunk str iter = runIter iter onDone onCont
where
onDone a str' = idoneM a (Chunk str `mappend` str')
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)