module Data.Enumerator.Binary
(
enumHandle
, enumHandleRange
, enumFile
, enumFileRange
, iterHandle
, fold
, foldM
, Data.Enumerator.Binary.map
, Data.Enumerator.Binary.mapM
, Data.Enumerator.Binary.mapM_
, Data.Enumerator.Binary.concatMap
, concatMapM
, mapAccum
, mapAccumM
, concatMapAccum
, concatMapAccumM
, Data.Enumerator.Binary.iterate
, iterateM
, Data.Enumerator.Binary.repeat
, repeatM
, Data.Enumerator.Binary.replicate
, replicateM
, generateM
, unfold
, unfoldM
, Data.Enumerator.Binary.drop
, Data.Enumerator.Binary.dropWhile
, Data.Enumerator.Binary.filter
, filterM
, Data.Enumerator.Binary.head
, head_
, Data.Enumerator.Binary.take
, takeWhile
, consume
, zip
, zip3
, zip4
, zip5
, zip6
, zip7
, zipWith
, zipWith3
, zipWith4
, zipWith5
, zipWith6
, zipWith7
, require
, isolate
, splitWhen
) where
import Prelude hiding (head, drop, takeWhile, mapM_, zip, zip3, zipWith, zipWith3)
import qualified Control.Exception as Exc
import qualified Control.Monad as CM
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (lift)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Monoid (mappend)
import Data.Word (Word8)
import qualified System.IO as IO
import System.IO.Error (isEOFError)
import Data.Enumerator hiding ( head, drop, iterateM, repeatM, replicateM
, generateM, filterM, consume, foldM
, concatMapM)
import qualified Data.Enumerator.List as EL
fold :: Monad m => (b -> Word8 -> b) -> b
-> Iteratee B.ByteString m b
fold step = EL.fold (B.foldl' step)
foldM :: Monad m => (b -> Word8 -> m b) -> b
-> Iteratee B.ByteString m b
foldM step = EL.foldM (\b bytes -> CM.foldM step b (B.unpack bytes))
unfold :: Monad m => (s -> Maybe (Word8, s)) -> s -> Enumerator B.ByteString m b
unfold f = checkContinue1 $ \loop s k -> case f s of
Nothing -> continue k
Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s'
unfoldM :: Monad m => (s -> m (Maybe (Word8, s))) -> s -> Enumerator B.ByteString m b
unfoldM f = checkContinue1 $ \loop s k -> do
fs <- lift (f s)
case fs of
Nothing -> continue k
Just (b, s') -> k (Chunks [B.singleton b]) >>== loop s'
map :: Monad m => (Word8 -> Word8) -> Enumeratee B.ByteString B.ByteString m b
map f = Data.Enumerator.Binary.concatMap (\x -> B.singleton (f x))
mapM :: Monad m => (Word8 -> m Word8) -> Enumeratee B.ByteString B.ByteString m b
mapM f = Data.Enumerator.Binary.concatMapM (\x -> liftM B.singleton (f x))
mapM_ :: Monad m => (Word8 -> m ()) -> Iteratee B.ByteString m ()
mapM_ f = foldM (\_ x -> f x >> return ()) ()
concatMap :: Monad m => (Word8 -> B.ByteString) -> Enumeratee B.ByteString B.ByteString m b
concatMap f = Data.Enumerator.Binary.concatMapM (return . f)
concatMapM :: Monad m => (Word8 -> m B.ByteString) -> Enumeratee B.ByteString B.ByteString m b
concatMapM f = checkDone (continue . step) where
step k EOF = yield (Continue k) EOF
step k (Chunks xs) = loop k (BL.unpack (BL.fromChunks xs))
loop k [] = continue (step k)
loop k (x:xs) = do
fx <- lift (f x)
k (Chunks [fx]) >>==
checkDoneEx (Chunks [B.pack xs]) (\k' -> loop k' xs)
concatMapAccum :: Monad m => (s -> Word8 -> (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b
concatMapAccum f s0 = checkDone (continue . step s0) where
step _ k EOF = yield (Continue k) EOF
step s k (Chunks xs) = loop s k xs
loop s k [] = continue (step s k)
loop s k (x:xs) = case B.uncons x of
Nothing -> loop s k xs
Just (b, x') -> case f s b of
(s', ai) -> k (Chunks [ai]) >>==
checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs))
concatMapAccumM :: Monad m => (s -> Word8 -> m (s, B.ByteString)) -> s -> Enumeratee B.ByteString B.ByteString m b
concatMapAccumM f s0 = checkDone (continue . step s0) where
step _ k EOF = yield (Continue k) EOF
step s k (Chunks xs) = loop s k xs
loop s k [] = continue (step s k)
loop s k (x:xs) = case B.uncons x of
Nothing -> loop s k xs
Just (b, x') -> do
(s', ai) <- lift (f s b)
k (Chunks [ai]) >>==
checkDoneEx (Chunks (x':xs)) (\k' -> loop s' k' (x':xs))
mapAccum :: Monad m => (s -> Word8 -> (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b
mapAccum f = concatMapAccum (\s w -> case f s w of (s', w') -> (s', B.singleton w'))
mapAccumM :: Monad m => (s -> Word8 -> m (s, Word8)) -> s -> Enumeratee B.ByteString B.ByteString m b
mapAccumM f = concatMapAccumM (\s w -> do
(s', w') <- f s w
return (s', B.singleton w'))
iterate :: Monad m => (Word8 -> Word8) -> Word8 -> Enumerator B.ByteString m b
iterate f = checkContinue1 $ \loop s k -> k (Chunks [B.singleton s]) >>== loop (f s)
iterateM :: Monad m => (Word8 -> m Word8) -> Word8 -> Enumerator B.ByteString m b
iterateM f base = worker (return base) where
worker = checkContinue1 $ \loop m_byte k -> do
byte <- lift m_byte
k (Chunks [B.singleton byte]) >>== loop (f byte)
repeat :: Monad m => Word8 -> Enumerator B.ByteString m b
repeat byte = EL.repeat (B.singleton byte)
repeatM :: Monad m => m Word8 -> Enumerator B.ByteString m b
repeatM next = EL.repeatM (liftM B.singleton next)
replicate :: Monad m => Integer -> Word8 -> Enumerator B.ByteString m b
replicate n byte = EL.replicate n (B.singleton byte)
replicateM :: Monad m => Integer -> m Word8 -> Enumerator B.ByteString m b
replicateM n next = EL.replicateM n (liftM B.singleton next)
generateM :: Monad m => m (Maybe Word8) -> Enumerator B.ByteString m b
generateM next = EL.generateM (liftM (liftM B.singleton) next)
filter :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b
filter p = Data.Enumerator.Binary.concatMap (\x -> B.pack [x | p x])
filterM :: Monad m => (Word8 -> m Bool) -> Enumeratee B.ByteString B.ByteString m b
filterM p = Data.Enumerator.Binary.concatMapM (\x -> liftM B.pack (CM.filterM p [x]))
take :: Monad m => Integer -> Iteratee B.ByteString m BL.ByteString
take n | n <= 0 = return BL.empty
take n = continue (loop id n) where
loop acc n' (Chunks xs) = iter where
lazy = BL.fromChunks xs
len = toInteger (BL.length lazy)
iter = if len < n'
then continue (loop (acc . (BL.append lazy)) (n' len))
else let
(xs', extra) = BL.splitAt (fromInteger n') lazy
in yield (acc xs') (toChunks extra)
loop acc _ EOF = yield (acc BL.empty) EOF
takeWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m BL.ByteString
takeWhile p = continue (loop id) where
loop acc (Chunks []) = continue (loop acc)
loop acc (Chunks xs) = iter where
lazy = BL.fromChunks xs
(xs', extra) = BL.span p lazy
iter = if BL.null extra
then continue (loop (acc . (BL.append lazy)))
else yield (acc xs') (toChunks extra)
loop acc EOF = yield (acc BL.empty) EOF
consume :: Monad m => Iteratee B.ByteString m BL.ByteString
consume = continue (loop id) where
loop acc (Chunks []) = continue (loop acc)
loop acc (Chunks xs) = iter where
lazy = BL.fromChunks xs
iter = continue (loop (acc . (BL.append lazy)))
loop acc EOF = yield (acc BL.empty) EOF
zip :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m (b1, b2)
zip i1 i2 = continue step where
step (Chunks []) = continue step
step stream@(Chunks _) = do
let enumStream s = case s of
Continue k -> k stream
Yield b extra -> yield b (mappend extra stream)
Error err -> throwError err
s1 <- lift (runIteratee (enumStream ==<< i1))
s2 <- lift (runIteratee (enumStream ==<< i2))
case (s1, s2) of
(Continue k1, Continue k2) -> zip (continue k1) (continue k2)
(Yield b1 _, Continue k2) -> zip (yield b1 (Chunks [])) (continue k2)
(Continue k1, Yield b2 _) -> zip (continue k1) (yield b2 (Chunks []))
(Yield b1 ex1, Yield b2 ex2) -> yield (b1, b2) (shorter ex1 ex2)
(Error err, _) -> throwError err
(_, Error err) -> throwError err
step EOF = do
b1 <- enumEOF =<< lift (runIteratee i1)
b2 <- enumEOF =<< lift (runIteratee i2)
return (b1, b2)
shorter c1@(Chunks xs) c2@(Chunks ys) = let
xs' = B.concat xs
ys' = B.concat ys
in if B.length xs' < B.length ys'
then c1
else c2
shorter _ _ = EOF
zip3 :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m (b1, b2, b3)
zip3 i1 i2 i3 = do
(b1, (b2, b3)) <- zip i1 (zip i2 i3)
return (b1, b2, b3)
zip4 :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m (b1, b2, b3, b4)
zip4 i1 i2 i3 i4 = do
(b1, (b2, b3, b4)) <- zip i1 (zip3 i2 i3 i4)
return (b1, b2, b3, b4)
zip5 :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m (b1, b2, b3, b4, b5)
zip5 i1 i2 i3 i4 i5 = do
(b1, (b2, b3, b4, b5)) <- zip i1 (zip4 i2 i3 i4 i5)
return (b1, b2, b3, b4, b5)
zip6 :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m b6
-> Iteratee B.ByteString m (b1, b2, b3, b4, b5, b6)
zip6 i1 i2 i3 i4 i5 i6 = do
(b1, (b2, b3, b4, b5, b6)) <- zip i1 (zip5 i2 i3 i4 i5 i6)
return (b1, b2, b3, b4, b5, b6)
zip7 :: Monad m
=> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m b6
-> Iteratee B.ByteString m b7
-> Iteratee B.ByteString m (b1, b2, b3, b4, b5, b6, b7)
zip7 i1 i2 i3 i4 i5 i6 i7 = do
(b1, (b2, b3, b4, b5, b6, b7)) <- zip i1 (zip6 i2 i3 i4 i5 i6 i7)
return (b1, b2, b3, b4, b5, b6, b7)
zipWith :: Monad m
=> (b1 -> b2 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m c
zipWith f i1 i2 = do
(b1, b2) <- zip i1 i2
return (f b1 b2)
zipWith3 :: Monad m
=> (b1 -> b2 -> b3 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m c
zipWith3 f i1 i2 i3 = do
(b1, b2, b3) <- zip3 i1 i2 i3
return (f b1 b2 b3)
zipWith4 :: Monad m
=> (b1 -> b2 -> b3 -> b4 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m c
zipWith4 f i1 i2 i3 i4 = do
(b1, b2, b3, b4) <- zip4 i1 i2 i3 i4
return (f b1 b2 b3 b4)
zipWith5 :: Monad m
=> (b1 -> b2 -> b3 -> b4 -> b5 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m c
zipWith5 f i1 i2 i3 i4 i5 = do
(b1, b2, b3, b4, b5) <- zip5 i1 i2 i3 i4 i5
return (f b1 b2 b3 b4 b5)
zipWith6 :: Monad m
=> (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m b6
-> Iteratee B.ByteString m c
zipWith6 f i1 i2 i3 i4 i5 i6 = do
(b1, b2, b3, b4, b5, b6) <- zip6 i1 i2 i3 i4 i5 i6
return (f b1 b2 b3 b4 b5 b6)
zipWith7 :: Monad m
=> (b1 -> b2 -> b3 -> b4 -> b5 -> b6 -> b7 -> c)
-> Iteratee B.ByteString m b1
-> Iteratee B.ByteString m b2
-> Iteratee B.ByteString m b3
-> Iteratee B.ByteString m b4
-> Iteratee B.ByteString m b5
-> Iteratee B.ByteString m b6
-> Iteratee B.ByteString m b7
-> Iteratee B.ByteString m c
zipWith7 f i1 i2 i3 i4 i5 i6 i7 = do
(b1, b2, b3, b4, b5, b6, b7) <- zip7 i1 i2 i3 i4 i5 i6 i7
return (f b1 b2 b3 b4 b5 b6 b7)
head :: Monad m => Iteratee B.ByteString m (Maybe Word8)
head = continue loop where
loop (Chunks xs) = case BL.uncons (BL.fromChunks xs) of
Just (char, extra) -> yield (Just char) (toChunks extra)
Nothing -> head
loop EOF = yield Nothing EOF
head_ :: Monad m => Iteratee B.ByteString m Word8
head_ = head >>= \x -> case x of
Just x' -> return x'
Nothing -> throwError (Exc.ErrorCall "head_: stream has ended")
drop :: Monad m => Integer -> Iteratee B.ByteString m ()
drop n | n <= 0 = return ()
drop n = continue (loop n) where
loop n' (Chunks xs) = iter where
lazy = BL.fromChunks xs
len = toInteger (BL.length lazy)
iter = if len < n'
then drop (n' len)
else yield () (toChunks (BL.drop (fromInteger n') lazy))
loop _ EOF = yield () EOF
dropWhile :: Monad m => (Word8 -> Bool) -> Iteratee B.ByteString m ()
dropWhile p = continue loop where
loop (Chunks xs) = iter where
lazy = BL.dropWhile p (BL.fromChunks xs)
iter = if BL.null lazy
then continue loop
else yield () (toChunks lazy)
loop EOF = yield () EOF
require :: Monad m => Integer -> Iteratee B.ByteString m ()
require n | n <= 0 = return ()
require n = continue (loop id n) where
loop acc n' (Chunks xs) = iter where
lazy = BL.fromChunks xs
len = toInteger (BL.length lazy)
iter = if len < n'
then continue (loop (acc . (BL.append lazy)) (n' len))
else yield () (toChunks (acc lazy))
loop _ _ EOF = throwError (Exc.ErrorCall "require: Unexpected EOF")
isolate :: Monad m => Integer -> Enumeratee B.ByteString B.ByteString m b
isolate n step | n <= 0 = return step
isolate n (Continue k) = continue loop where
loop (Chunks []) = continue loop
loop (Chunks xs) = iter where
lazy = BL.fromChunks xs
len = toInteger (BL.length lazy)
iter = if len <= n
then k (Chunks xs) >>== isolate (n len)
else let
(s1, s2) = BL.splitAt (fromInteger n) lazy
in k (toChunks s1) >>== (\step -> yield step (toChunks s2))
loop EOF = k EOF >>== (\step -> yield step EOF)
isolate n step = drop n >> return step
splitWhen :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b
splitWhen p = loop where
loop = checkDone step
step k = isEOF >>= \eof -> if eof
then yield (Continue k) EOF
else do
lazy <- takeWhile (not . p)
let bytes = B.concat (BL.toChunks lazy)
eof <- isEOF
drop 1
if BL.null lazy && eof
then yield (Continue k) EOF
else k (Chunks [bytes]) >>== loop
enumHandle :: MonadIO m
=> Integer
-> IO.Handle
-> Enumerator B.ByteString m b
enumHandle bufferSize h = checkContinue0 $ \loop k -> do
let intSize = fromInteger bufferSize
bytes <- tryIO (getBytes h intSize)
if B.null bytes
then continue k
else k (Chunks [bytes]) >>== loop
enumHandleRange :: MonadIO m
=> Integer
-> Maybe Integer
-> Maybe Integer
-> IO.Handle
-> Enumerator B.ByteString m b
enumHandleRange bufferSize offset count h s = seek >> enum where
seek = case offset of
Nothing -> return ()
Just off -> tryIO (IO.hSeek h IO.AbsoluteSeek off)
enum = case count of
Just n -> enumRange n s
Nothing -> enumHandle bufferSize h s
enumRange = checkContinue1 $ \loop n k -> let
rem = fromInteger (min bufferSize n)
keepGoing = do
bytes <- tryIO (getBytes h rem)
if B.null bytes
then continue k
else feed bytes
feed bs = k (Chunks [bs]) >>== loop (n (toInteger (B.length bs)))
in if rem <= 0
then continue k
else keepGoing
getBytes :: IO.Handle -> Int -> IO B.ByteString
getBytes h n = do
hasInput <- Exc.catch
(IO.hWaitForInput h (1))
(\err -> if isEOFError err
then return False
else Exc.throwIO err)
if hasInput
then B.hGetNonBlocking h n
else return B.empty
enumFile :: FilePath -> Enumerator B.ByteString IO b
enumFile path = enumFileRange path Nothing Nothing
enumFileRange :: FilePath
-> Maybe Integer
-> Maybe Integer
-> Enumerator B.ByteString IO b
enumFileRange path offset count step = do
h <- tryIO (IO.openBinaryFile path IO.ReadMode)
let iter = enumHandleRange 4096 offset count h step
Iteratee (Exc.finally (runIteratee iter) (IO.hClose h))
iterHandle :: MonadIO m => IO.Handle
-> Iteratee B.ByteString m ()
iterHandle h = continue step where
step EOF = yield () EOF
step (Chunks []) = continue step
step (Chunks bytes) = do
tryIO (CM.mapM_ (B.hPut h) bytes)
continue step
toChunks :: BL.ByteString -> Stream B.ByteString
toChunks = Chunks . BL.toChunks