module Data.Iteratee.Base (
StreamG (..),
IterateeG (..),
IterateeGM (..),
EnumeratorN,
EnumeratorGM,
EnumeratorGMM,
liftI,
(>>==),
(==<<),
joinI,
stream2list,
iterErr,
iterReportError,
break,
dropWhile,
drop,
head,
peek,
skipToEof,
seek,
take,
takeR,
mapStream,
convStream,
enumEof,
enumErr,
(>.),
enumPure1Chunk,
enumPureNChunk,
FileOffset,
bindm
)
where
import Prelude hiding (head, drop, dropWhile, take, break)
import qualified Prelude as P
import qualified Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.IO.Base
import Control.Monad.Trans
import Control.Monad.Identity
import System.IO
bindm :: Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)
bindm m f = m >>= maybe (return Nothing) f
data (SC.StreamChunk c el) => StreamG c el = EOF | Error String | Chunk (c el)
data IterateeG s el m a
= Done a (StreamG s el)
| Cont (StreamG s el -> IterateeGM s el m a)
| Seek FileOffset (StreamG s el -> IterateeGM s el m a)
instance (Show a) => Show (IterateeG s el m a) where
show (Done a _) = "Iteratee done: " ++ P.show a
show (Cont _k) = "Iteratee: incomplete"
show (Seek f _k) = "Iteratee: seek to " ++ P.show f ++ "requested"
newtype IterateeGM s el m a = IM {unIM :: m (IterateeG s el m a)}
liftI :: Monad m => IterateeG s el m a -> IterateeGM s el m a
liftI = IM . return
infixl 1 >>==
(>>==) :: Monad m =>
IterateeGM s el m a ->
(IterateeG s el m a -> IterateeGM s' el' m b) ->
IterateeGM s' el' m b
m >>== f = IM (unIM m >>= unIM . f)
infixr 1 ==<<
(==<<) :: Monad m =>
(IterateeG s el m a -> IterateeGM s' el' m b)
-> IterateeGM s el m a
-> IterateeGM s' el' m b
(==<<) = flip (>>==)
joinI :: (SC.StreamChunk s el, SC.StreamChunk s' el', Monad m) =>
IterateeGM s el m (IterateeG s' el' m a) ->
IterateeGM s el m a
joinI m = m >>= (\iter -> enumEof iter >>== check)
where
check (Done x (Error str)) = liftI $ Done x (Error str)
check (Done x _) = liftI $ Done x EOF
check (Cont _) = error "joinI: can't happen: EOF didn't terminate"
check (Seek _ _) = error "joinI: can't happen: EOF didn't terminate"
instance (SC.StreamChunk s el, Monad m) => Monad (IterateeGM s el m) where
return x = liftI $ Done x (Chunk SC.empty)
m >>= f = iter_bind m f
iter_bind :: (SC.StreamChunk s el, Monad m ) =>
IterateeGM s el m a ->
(a -> IterateeGM s el m b) ->
IterateeGM s el m b
iter_bind m f = m >>== docase
where
docase (Done a (Chunk vec))
| SC.null vec = f a
docase (Done a stream) = f a >>== (\r -> case r of
Done x _ -> liftI $ Done x stream
Cont k -> k stream
iter -> liftI iter)
docase (Cont k) = liftI $ Cont ((>>= f) . k)
docase (Seek off k) = liftI $ Seek off ((>>= f) . k)
instance (Monad m, Functor m) => Functor (IterateeGM s el m) where
fmap f m = m >>== docase
where
docase (Done a stream) = liftI $ Done (f a) stream
docase (Cont k) = liftI $ Cont (fmap f . k)
docase (Seek off k) = liftI $ Seek off (fmap f . k)
instance (SC.StreamChunk s el) => MonadTrans (IterateeGM s el) where
lift m = IM (m >>= unIM . return)
instance (SC.StreamChunk s el, MonadIO m) => MonadIO (IterateeGM s el m) where
liftIO = lift . liftIO
stream2list :: (SC.StreamChunk s el, Monad m) => IterateeGM s el m [el]
stream2list = liftI $ Cont (step SC.empty)
where
step acc (Chunk ls) | SC.null ls = liftI $ Cont (step acc)
| otherwise = liftI $ Cont (step $ acc `SC.append` ls)
step acc stream = liftI $ Done (SC.toList acc) stream
iterErr :: (SC.StreamChunk s el, Monad m) => String -> IterateeGM s el m ()
iterErr err = liftI $ Cont step
where
step _ = liftI $ Done () (Error err)
iterReportError :: (SC.StreamChunk s el, Monad m) =>
IterateeGM s el m (Maybe String)
iterReportError = liftI $ Cont step
where
step s@(Error str) = liftI $ Done (Just str) s
step s = liftI $ Done Nothing s
break :: (SC.StreamChunk s el, Monad m) =>
(el -> Bool) ->
IterateeGM s el m (s el, Maybe el)
break cpred = liftI $ Cont (liftI . step SC.empty)
where
step before (Chunk str)
| SC.null str = Cont (liftI . step before)
| otherwise = case SC.findIndex cpred str of
Nothing -> Cont (liftI . step (before `SC.append` str))
Just ix -> let (str', tail') = SC.splitAt ix str
in
done (before `SC.append` str') (Just $ SC.head tail') (Chunk $ SC.tail tail')
step before stream = done before Nothing stream
done line' char = Done (line', char)
dropWhile :: (SC.StreamChunk s el, Monad m) =>
(el -> Bool) ->
IterateeGM s el m ()
dropWhile cpred = liftI $ Cont step
where
step (Chunk str)
| SC.null str = dropWhile cpred
| otherwise = let remm = SC.dropWhile cpred str
in
case SC.null remm of
True -> dropWhile cpred
False -> liftI $ Done () (Chunk remm)
step stream = liftI $ Done () stream
head :: (SC.StreamChunk s el, Monad m) =>
IterateeGM s el m (Maybe el)
head = liftI $ Cont step
where
step (Chunk vec)
| SC.null vec = head
| otherwise = liftI $ Done (Just $ SC.head vec) (Chunk $ SC.tail vec)
step stream = liftI $ Done Nothing stream
peek :: (SC.StreamChunk s el, Monad m) =>
IterateeGM s el m (Maybe el)
peek = liftI $ Cont step
where
step s@(Chunk vec)
| SC.null vec = peek
| otherwise = liftI $ Done (Just $ SC.head vec) s
step stream = liftI $ Done Nothing stream
skipToEof :: (SC.StreamChunk s el, Monad m) => IterateeGM s el m ()
skipToEof = liftI $ Cont step
where
step (Chunk _) = skipToEof
step _ = return ()
drop :: (SC.StreamChunk s el, Monad m) => Int -> IterateeGM s el m ()
drop 0 = return ()
drop n = liftI $ Cont step
where
step (Chunk str) | SC.length str <= n = drop (n SC.length str)
step (Chunk str) = liftI $ Done () (Chunk s2)
where
(_s1,s2) = SC.splitAt n str
step stream = liftI $ Done () stream
seek :: (SC.StreamChunk s el, Monad m) => FileOffset -> IterateeGM s el m ()
seek off = liftI (Seek off step)
where
step = liftI . Done ()
type EnumeratorN s_outer el_outer s_inner el_inner m a =
IterateeG s_inner el_inner m a ->
IterateeGM s_outer el_outer m (IterateeG s_inner el_inner m a)
take :: (SC.StreamChunk s el, Monad m) =>
Int -> EnumeratorN s el s el m a
take 0 iter = return iter
take n iter@Done{} = drop n >> return iter
take n (Seek _off k) = liftI $ Cont step
where
step chunk@(Chunk str)
| SC.null str = liftI $ Cont step
| SC.length str <= n = take (n SC.length str) ==<< k chunk
step (Chunk str) = done (Chunk s1) (Chunk s2)
where (s1,s2) = SC.splitAt n str
step stream = done stream stream
done s1 s2 = k s1 >>== \r -> liftI $ Done r s2
take n (Cont k) = liftI $ Cont step
where
step chunk@(Chunk str)
| SC.null str = liftI $ Cont step
| SC.length str <= n = take (n SC.length str) ==<< k chunk
step (Chunk str) = done (Chunk s1) (Chunk s2)
where (s1,s2) = SC.splitAt n str
step stream = done stream stream
done s1 s2 = k s1 >>== \r -> liftI $ Done r s2
takeR :: (SC.StreamChunk s el, Monad m) =>
Int ->
EnumeratorN s el s el m a
takeR 0 iter = return iter
takeR _n iter@Done{} = return iter
takeR _n iter@Seek{} = return iter
takeR n (Cont k) = liftI $ Cont step
where
step chunk@(Chunk str)
| SC.null str = liftI $ Cont step
| SC.length str <= n = takeR (n SC.length str) ==<< k chunk
step (Chunk str) = done (Chunk s1) (Chunk s2)
where (s1,s2) = SC.splitAt n str
step stream = done stream stream
done s1 s2 = k s1 >>== \r -> liftI $ Done r s2
mapStream :: (SC.StreamChunk s el, SC.StreamChunk s el', Monad m) =>
(el -> el') ->
EnumeratorN s el s el' m a
mapStream _f iter@Done{} = return iter
mapStream f (Cont k) = liftI $ Cont step
where
step (Chunk str)
| SC.null str = liftI $ Cont step
step (Chunk str) = k (Chunk (SC.cMap f str)) >>== mapStream f
step EOF = k EOF >>== \r -> liftI $ Done r EOF
step (Error err) = k (Error err) >>== \r ->
liftI $ Done r (Error err)
mapStream f (Seek off k) = liftI $ Seek off step
where
step (Chunk str)
| SC.null str = liftI $ Cont step
step (Chunk str) = k (Chunk (SC.cMap f str)) >>== mapStream f
step EOF = k EOF >>== \r -> liftI $ Done r EOF
step (Error err) = k (Error err) >>== \r ->
liftI $ Done r (Error err)
convStream :: (SC.StreamChunk s el, SC.StreamChunk s' el', Monad m) =>
IterateeGM s el m (Maybe (s' el')) -> EnumeratorN s el s' el' m a
convStream _fi iter@Done{} = return iter
convStream fi (Cont k) = fi >>=
(convStream fi ==<<) . k . maybe (Error "conv: stream error") Chunk
convStream fi (Seek _off k) = fi >>=
(convStream fi ==<<) . k . maybe (Error "conv: stream error") Chunk
type EnumeratorGM s el m a = IterateeG s el m a -> IterateeGM s el m a
type EnumeratorGMM sfrom elfrom sto elto m a =
IterateeG sto elto m a -> IterateeGM sfrom elfrom m a
enumEof :: (SC.StreamChunk s el, Monad m) => EnumeratorGM s el m a
enumEof (Done x _) = liftI $ Done x EOF
enumEof (Cont k) = k EOF
enumEof (Seek _off k) = k EOF
enumErr :: (SC.StreamChunk s el, Monad m) => String -> EnumeratorGM s el m a
enumErr str (Done x _) = liftI $ Done x (Error str)
enumErr str (Cont k) = k (Error str)
enumErr str (Seek _off k) = k (Error str)
(>.):: (SC.StreamChunk s el, Monad m) =>
EnumeratorGM s el m a -> EnumeratorGM s el m a -> EnumeratorGM s el m a
e1 >. e2 = (e2 ==<<) . e1
enumPure1Chunk :: (SC.StreamChunk s el, Monad m) =>
s el ->
EnumeratorGM s el m a
enumPure1Chunk _str iter@Done{} = liftI iter
enumPure1Chunk str (Cont k) = k (Chunk str)
enumPure1Chunk _str (Seek _off _k) = fail "enumPure1Chunk cannot handle random IO"
enumPureNChunk :: (SC.StreamChunk s el, Monad m) =>
s el ->
Int ->
EnumeratorGM s el m a
enumPureNChunk _str _n iter@Done{} = liftI iter
enumPureNChunk str _n iter | SC.null str = liftI iter
enumPureNChunk str n (Cont k) = enumPureNChunk s2 n ==<< k (Chunk s1)
where (s1,s2) = SC.splitAt n str
enumPureNChunk _str _n (Seek _off _k) = fail "enumPureNChunk cannot handle ranom IO"