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
, isolateWhile
, 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.Internal
import Data.Enumerator (isEOF, throwError, tryIO)
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]) (`loop` 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) >>== (`yield` toChunks s2)
loop EOF = k EOF >>== (`yield` EOF)
isolate n step = drop n >> return step
isolateWhile :: Monad m => (Word8 -> Bool) -> Enumeratee B.ByteString B.ByteString m b
isolateWhile p (Continue k) = continue loop where
loop (Chunks []) = continue loop
loop (Chunks xs) = iter where
lazy = BL.fromChunks xs
(s1, s2) = BL.span p lazy
iter = if BL.null s2
then k (Chunks xs) >>== isolateWhile p
else k (toChunks s1) >>== (`yield` toChunks s2)
loop EOF = k EOF >>== (`yield` EOF)
isolateWhile p step = Data.Enumerator.Binary.dropWhile p >> 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