{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
-- | Streaming compression and decompression using conduits.
--
-- Parts of this code were taken from zlib-enum and adapted for conduits.
module Data.Conduit.Zlib (
    -- * Conduits
    compress, decompress, gzip, ungzip,
    -- * Flushing
    compressFlush, decompressFlush,
    -- * Decompression combinators
    multiple,
    -- * Re-exported from zlib-bindings
    WindowBits (..), defaultWindowBits
) where

import Data.Streaming.Zlib
import Data.Conduit
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Control.Monad (unless, liftM)
import Control.Monad.Trans.Class (lift, MonadTrans)
import Control.Monad.Primitive (PrimMonad, unsafePrimToPrim)
import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Data.Function (fix)

-- | Gzip compression with default parameters.
gzip :: (MonadThrow m, PrimMonad m) => ConduitT ByteString ByteString m ()
gzip :: ConduitT ByteString ByteString m ()
gzip = Int -> WindowBits -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
Int -> WindowBits -> ConduitT ByteString ByteString m ()
compress (-Int
1) (Int -> WindowBits
WindowBits Int
31)

-- | Gzip decompression with default parameters.
ungzip :: (PrimMonad m, MonadThrow m) => ConduitT ByteString ByteString m ()
ungzip :: ConduitT ByteString ByteString m ()
ungzip = WindowBits -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
WindowBits -> ConduitT ByteString ByteString m ()
decompress (Int -> WindowBits
WindowBits Int
31)

unsafeLiftIO :: (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO :: IO a -> m a
unsafeLiftIO = IO a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim

-- |
-- Decompress (inflate) a stream of 'ByteString's. For example:
--
-- >    sourceFile "test.z" $= decompress defaultWindowBits $$ sinkFile "test"

decompress
    :: (PrimMonad m, MonadThrow m)
    => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
    -> ConduitT ByteString ByteString m ()
decompress :: WindowBits -> ConduitT ByteString ByteString m ()
decompress =
    ConduitT ByteString ByteString m (Maybe (Flush ByteString))
-> (Flush ByteString -> ConduitT ByteString ByteString m ())
-> (ByteString -> ConduitT ByteString ByteString m ())
-> WindowBits
-> ConduitT ByteString ByteString m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t) =>
t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ())
-> (ByteString -> t m ())
-> WindowBits
-> t m ()
helperDecompress ((Maybe ByteString -> Maybe (Flush ByteString))
-> ConduitT ByteString ByteString m (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe (Flush ByteString))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((ByteString -> Flush ByteString)
-> Maybe ByteString -> Maybe (Flush ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk) ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await) Flush ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => Flush o -> ConduitT i o m ()
yield' ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover
  where
    yield' :: Flush o -> ConduitT i o m ()
yield' Flush o
Flush = () -> ConduitT i o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    yield' (Chunk o
bs) = o -> ConduitT i o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
bs

-- | Same as 'decompress', but allows you to explicitly flush the stream.
decompressFlush
    :: (PrimMonad m, MonadThrow m)
    => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
    -> ConduitT (Flush ByteString) (Flush ByteString) m ()
decompressFlush :: WindowBits -> ConduitT (Flush ByteString) (Flush ByteString) m ()
decompressFlush = ConduitT
  (Flush ByteString) (Flush ByteString) m (Maybe (Flush ByteString))
-> (Flush ByteString
    -> ConduitT (Flush ByteString) (Flush ByteString) m ())
-> (ByteString
    -> ConduitT (Flush ByteString) (Flush ByteString) m ())
-> WindowBits
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t) =>
t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ())
-> (ByteString -> t m ())
-> WindowBits
-> t m ()
helperDecompress ConduitT
  (Flush ByteString) (Flush ByteString) m (Maybe (Flush ByteString))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await Flush ByteString
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Flush ByteString
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover (Flush ByteString
 -> ConduitT (Flush ByteString) (Flush ByteString) m ())
-> (ByteString -> Flush ByteString)
-> ByteString
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk)

helperDecompress :: (Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t)
                 => t m (Maybe (Flush ByteString))
                 -> (Flush ByteString -> t m ())
                 -> (ByteString -> t m ())
                 -> WindowBits
                 -> t m ()
helperDecompress :: t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ())
-> (ByteString -> t m ())
-> WindowBits
-> t m ()
helperDecompress t m (Maybe (Flush ByteString))
await' Flush ByteString -> t m ()
yield' ByteString -> t m ()
leftover' WindowBits
config = do
    -- Initialize the stateful inflater, which will be used below
    -- This inflater is never exposed outside of this function
    Inflate
inf <- m Inflate -> t m Inflate
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Inflate -> t m Inflate) -> m Inflate -> t m Inflate
forall a b. (a -> b) -> a -> b
$ IO Inflate -> m Inflate
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO Inflate -> m Inflate) -> IO Inflate -> m Inflate
forall a b. (a -> b) -> a -> b
$ WindowBits -> IO Inflate
initInflate WindowBits
config

    -- Some helper functions used by the main feeder loop below

    let -- Flush any remaining inflated bytes downstream
        flush :: t m ()
flush = do
            ByteString
chunk <- m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString) -> m ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> m ByteString
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
flushInflate Inflate
inf
            Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
chunk) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$ Flush ByteString -> t m ()
yield' (Flush ByteString -> t m ()) -> Flush ByteString -> t m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk ByteString
chunk

        -- Get any input which is unused by the inflater
        getUnused :: t m ByteString
getUnused = m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString) -> m ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> m ByteString
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
getUnusedInflate Inflate
inf

        -- If there is any unused data, return it as leftovers to the stream
        unused :: t m ()
unused = do
            ByteString
rem' <- t m ByteString
getUnused
            Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
rem') (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> t m ()
leftover' ByteString
rem'

    -- Main loop: feed data from upstream into the inflater
    (t m () -> t m ()) -> t m ()
forall a. (a -> a) -> a
fix ((t m () -> t m ()) -> t m ()) -> (t m () -> t m ()) -> t m ()
forall a b. (a -> b) -> a -> b
$ \t m ()
feeder -> do
        Maybe (Flush ByteString)
mnext <- t m (Maybe (Flush ByteString))
await'
        case Maybe (Flush ByteString)
mnext of
            -- No more data is available from upstream
            Maybe (Flush ByteString)
Nothing -> do
                -- Flush any remaining uncompressed data
                t m ()
flush
                -- Return the rest of the unconsumed data as leftovers
                t m ()
unused
            -- Another chunk of compressed data arrived
            Just (Chunk ByteString
x) -> do
                -- Feed the compressed data into the inflater, returning a
                -- "popper" which will return chunks of decompressed data
                Popper
popper <- m Popper -> t m Popper
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Popper -> t m Popper) -> m Popper -> t m Popper
forall a b. (a -> b) -> a -> b
$ IO Popper -> m Popper
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO Popper -> m Popper) -> IO Popper -> m Popper
forall a b. (a -> b) -> a -> b
$ Inflate -> ByteString -> IO Popper
feedInflate Inflate
inf ByteString
x

                -- Loop over the popper grabbing decompressed chunks and
                -- yielding them downstream
                (t m () -> t m ()) -> t m ()
forall a. (a -> a) -> a
fix ((t m () -> t m ()) -> t m ()) -> (t m () -> t m ()) -> t m ()
forall a b. (a -> b) -> a -> b
$ \t m ()
pop -> do
                    PopperRes
mbs <- m PopperRes -> t m PopperRes
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PopperRes -> t m PopperRes) -> m PopperRes -> t m PopperRes
forall a b. (a -> b) -> a -> b
$ Popper -> m PopperRes
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO Popper
popper
                    case PopperRes
mbs of
                        -- No more data from this popper
                        PopperRes
PRDone -> do
                            ByteString
rem' <- t m ByteString
getUnused
                            if ByteString -> Bool
S.null ByteString
rem'
                                -- No data was unused by the inflater, so let's
                                -- fill it up again and get more data out of it
                                then t m ()
feeder
                                -- In this case, there is some unconsumed data,
                                -- meaning the compressed stream is complete.
                                -- At this point, we need to stop feeding,
                                -- return the unconsumed data as leftovers, and
                                -- flush any remaining content (which should be
                                -- nothing)
                                else do
                                    t m ()
flush
                                    ByteString -> t m ()
leftover' ByteString
rem'
                        -- Another chunk available, yield it downstream and
                        -- loop again
                        PRNext ByteString
bs -> do
                            Flush ByteString -> t m ()
yield' (ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk ByteString
bs)
                            t m ()
pop
                        -- An error occurred inside zlib, throw it
                        PRError ZlibException
e -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ZlibException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ZlibException
e
            -- We've been asked to flush the stream
            Just Flush ByteString
Flush -> do
                -- Get any uncompressed data waiting for us
                t m ()
flush
                -- Put a Flush in the stream
                Flush ByteString -> t m ()
yield' Flush ByteString
forall a. Flush a
Flush
                -- Feed in more data
                t m ()
feeder

-- |
-- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control
-- the format (zlib vs. gzip).

compress
    :: (PrimMonad m, MonadThrow m)
    => Int         -- ^ Compression level
    -> WindowBits  -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
    -> ConduitT ByteString ByteString m ()
compress :: Int -> WindowBits -> ConduitT ByteString ByteString m ()
compress =
    ConduitT ByteString ByteString m (Maybe (Flush ByteString))
-> (Flush ByteString -> ConduitT ByteString ByteString m ())
-> Int
-> WindowBits
-> ConduitT ByteString ByteString m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t) =>
t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ()) -> Int -> WindowBits -> t m ()
helperCompress ((Maybe ByteString -> Maybe (Flush ByteString))
-> ConduitT ByteString ByteString m (Maybe ByteString)
-> ConduitT ByteString ByteString m (Maybe (Flush ByteString))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((ByteString -> Flush ByteString)
-> Maybe ByteString -> Maybe (Flush ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk) ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await) Flush ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => Flush o -> ConduitT i o m ()
yield'
  where
    yield' :: Flush o -> ConduitT i o m ()
yield' Flush o
Flush = () -> ConduitT i o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    yield' (Chunk o
bs) = o -> ConduitT i o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield o
bs

-- | Same as 'compress', but allows you to explicitly flush the stream.
compressFlush
    :: (PrimMonad m, MonadThrow m)
    => Int         -- ^ Compression level
    -> WindowBits  -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
    -> ConduitT (Flush ByteString) (Flush ByteString) m ()
compressFlush :: Int
-> WindowBits
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
compressFlush = ConduitT
  (Flush ByteString) (Flush ByteString) m (Maybe (Flush ByteString))
-> (Flush ByteString
    -> ConduitT (Flush ByteString) (Flush ByteString) m ())
-> Int
-> WindowBits
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t) =>
t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ()) -> Int -> WindowBits -> t m ()
helperCompress ConduitT
  (Flush ByteString) (Flush ByteString) m (Maybe (Flush ByteString))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await Flush ByteString
-> ConduitT (Flush ByteString) (Flush ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield

helperCompress :: (Monad (t m), PrimMonad m, MonadThrow m, MonadTrans t)
               => t m (Maybe (Flush ByteString))
               -> (Flush ByteString -> t m ())
               -> Int
               -> WindowBits
               -> t m ()
helperCompress :: t m (Maybe (Flush ByteString))
-> (Flush ByteString -> t m ()) -> Int -> WindowBits -> t m ()
helperCompress t m (Maybe (Flush ByteString))
await' Flush ByteString -> t m ()
yield' Int
level WindowBits
config =
    t m (Maybe (Flush ByteString))
await' t m (Maybe (Flush ByteString))
-> (Maybe (Flush ByteString) -> t m ()) -> t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t m ()
-> (Flush ByteString -> t m ())
-> Maybe (Flush ByteString)
-> t m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Flush ByteString -> t m ()
start
  where
    start :: Flush ByteString -> t m ()
start Flush ByteString
input = do
        Deflate
def <- m Deflate -> t m Deflate
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Deflate -> t m Deflate) -> m Deflate -> t m Deflate
forall a b. (a -> b) -> a -> b
$ IO Deflate -> m Deflate
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO Deflate -> m Deflate) -> IO Deflate -> m Deflate
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> IO Deflate
initDeflate Int
level WindowBits
config
        Deflate -> Flush ByteString -> t m ()
push Deflate
def Flush ByteString
input

    continue :: Deflate -> t m ()
continue Deflate
def = t m (Maybe (Flush ByteString))
await' t m (Maybe (Flush ByteString))
-> (Maybe (Flush ByteString) -> t m ()) -> t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t m ()
-> (Flush ByteString -> t m ())
-> Maybe (Flush ByteString)
-> t m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Deflate -> t m ()
close Deflate
def) (Deflate -> Flush ByteString -> t m ()
push Deflate
def)

    goPopper :: Popper -> t m ()
goPopper Popper
popper = do
        PopperRes
mbs <- m PopperRes -> t m PopperRes
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PopperRes -> t m PopperRes) -> m PopperRes -> t m PopperRes
forall a b. (a -> b) -> a -> b
$ Popper -> m PopperRes
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO Popper
popper
        case PopperRes
mbs of
            PopperRes
PRDone -> () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PRNext ByteString
bs -> Flush ByteString -> t m ()
yield' (ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk ByteString
bs) t m () -> t m () -> t m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Popper -> t m ()
goPopper Popper
popper
            PRError ZlibException
e -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ZlibException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ZlibException
e

    push :: Deflate -> Flush ByteString -> t m ()
push Deflate
def (Chunk ByteString
x) = do
        Popper
popper <- m Popper -> t m Popper
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Popper -> t m Popper) -> m Popper -> t m Popper
forall a b. (a -> b) -> a -> b
$ IO Popper -> m Popper
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (IO Popper -> m Popper) -> IO Popper -> m Popper
forall a b. (a -> b) -> a -> b
$ Deflate -> ByteString -> IO Popper
feedDeflate Deflate
def ByteString
x
        Popper -> t m ()
goPopper Popper
popper
        Deflate -> t m ()
continue Deflate
def

    push Deflate
def Flush ByteString
Flush = do
        PopperRes
mchunk <- m PopperRes -> t m PopperRes
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PopperRes -> t m PopperRes) -> m PopperRes -> t m PopperRes
forall a b. (a -> b) -> a -> b
$ Popper -> m PopperRes
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (Popper -> m PopperRes) -> Popper -> m PopperRes
forall a b. (a -> b) -> a -> b
$ Deflate -> Popper
flushDeflate Deflate
def
        case PopperRes
mchunk of
            PopperRes
PRDone -> () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PRNext ByteString
x -> Flush ByteString -> t m ()
yield' (Flush ByteString -> t m ()) -> Flush ByteString -> t m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk ByteString
x
            PRError ZlibException
e -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ZlibException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ZlibException
e
        Flush ByteString -> t m ()
yield' Flush ByteString
forall a. Flush a
Flush
        Deflate -> t m ()
continue Deflate
def

    close :: Deflate -> t m ()
close Deflate
def = do
        PopperRes
mchunk <- m PopperRes -> t m PopperRes
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m PopperRes -> t m PopperRes) -> m PopperRes -> t m PopperRes
forall a b. (a -> b) -> a -> b
$ Popper -> m PopperRes
forall (m :: * -> *) a. (PrimMonad m, MonadThrow m) => IO a -> m a
unsafeLiftIO (Popper -> m PopperRes) -> Popper -> m PopperRes
forall a b. (a -> b) -> a -> b
$ Deflate -> Popper
finishDeflate Deflate
def
        case PopperRes
mchunk of
            PopperRes
PRDone -> () -> t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            PRNext ByteString
chunk -> Flush ByteString -> t m ()
yield' (ByteString -> Flush ByteString
forall a. a -> Flush a
Chunk ByteString
chunk) t m () -> t m () -> t m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Deflate -> t m ()
close Deflate
def
            PRError ZlibException
e -> m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> m () -> t m ()
forall a b. (a -> b) -> a -> b
$ ZlibException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ZlibException
e

-- | The standard 'decompress' and 'ungzip' functions will only decompress a
-- single compressed entity from the stream. This combinator will exhaust the
-- stream completely of all individual compressed entities. This is useful for
-- cases where you have a concatenated archive, e.g. @cat file1.gz file2.gz >
-- combined.gz@.
--
-- Usage:
--
-- > sourceFile "combined.gz" $$ multiple ungzip =$ consume
--
-- This combinator will not fail on an empty stream. If you want to ensure that
-- at least one compressed entity in the stream exists, consider a usage such
-- as:
--
-- > sourceFile "combined.gz" $$ (ungzip >> multiple ungzip) =$ consume
--
-- @since 1.1.10
multiple :: Monad m
         => ConduitT ByteString a m ()
         -> ConduitT ByteString a m ()
multiple :: ConduitT ByteString a m () -> ConduitT ByteString a m ()
multiple ConduitT ByteString a m ()
inner =
    ConduitT ByteString a m ()
loop
  where
    loop :: ConduitT ByteString a m ()
loop = do
        Maybe ByteString
mbs <- ConduitT ByteString a m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
        case Maybe ByteString
mbs of
            Maybe ByteString
Nothing -> () -> ConduitT ByteString a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ByteString
bs
                | ByteString -> Bool
S.null ByteString
bs -> ConduitT ByteString a m ()
loop
                | Bool
otherwise -> do
                    ByteString -> ConduitT ByteString a m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                    ConduitT ByteString a m ()
inner
                    ConduitT ByteString a m ()
loop