{-# LANGUAGE CPP, RankNTypes, DeriveDataTypeable, BangPatterns #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) 2006-2015 Duncan Coutts
-- License     :  BSD-style
--
-- Maintainer  :  duncan@community.haskell.org
--
-- Pure and IO stream based interfaces to lower level zlib wrapper
--
-----------------------------------------------------------------------------
module Codec.Compression.Zlib.Internal (

  -- * Pure interface
  compress,
  decompress,

  -- * Monadic incremental interface
  -- $incremental-compression

  -- ** Using incremental compression
  -- $using-incremental-compression

  CompressStream(..),
  compressST,
  compressIO,
  foldCompressStream,
  foldCompressStreamWithInput,

  -- ** Using incremental decompression
  -- $using-incremental-decompression

  DecompressStream(..),
  DecompressError(..),
  decompressST,
  decompressIO,
  foldDecompressStream,
  foldDecompressStreamWithInput,

  -- * The compression parameter types
  CompressParams(..),
  defaultCompressParams,
  DecompressParams(..),
  defaultDecompressParams,
  Stream.Format(..),
    Stream.gzipFormat,
    Stream.zlibFormat,
    Stream.rawFormat,
    Stream.gzipOrZlibFormat,
  Stream.CompressionLevel(..),
    Stream.defaultCompression,
    Stream.noCompression,
    Stream.bestSpeed,
    Stream.bestCompression,
    Stream.compressionLevel,
  Stream.Method(..),
    Stream.deflateMethod,
  Stream.WindowBits(..),
    Stream.defaultWindowBits,
    Stream.windowBits,
  Stream.MemoryLevel(..),
    Stream.defaultMemoryLevel,
    Stream.minMemoryLevel,
    Stream.maxMemoryLevel,
    Stream.memoryLevel,
  Stream.CompressionStrategy(..),
    Stream.defaultStrategy,
    Stream.filteredStrategy,
    Stream.huffmanOnlyStrategy,

  ) where

import Prelude hiding (length)
import Control.Monad (when)
import Control.Exception (Exception, throw, assert)
import Control.Monad.ST.Lazy hiding (stToIO)
import Control.Monad.ST.Strict (stToIO)
#if __GLASGOW_HASKELL__ >= 702
import qualified Control.Monad.ST.Unsafe as Unsafe (unsafeIOToST)
#else
import qualified Control.Monad.ST.Strict as Unsafe (unsafeIOToST)
#endif
import Data.Typeable (Typeable)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString          as S
import qualified Data.ByteString.Internal as S
import Data.Word (Word8)
import GHC.IO (noDuplicate)

import qualified Codec.Compression.Zlib.Stream as Stream
import Codec.Compression.Zlib.ByteStringCompat (mkBS, withBS)
import Codec.Compression.Zlib.Stream (Stream)

-- | The full set of parameters for compression. The defaults are
-- 'defaultCompressParams'.
--
-- The 'compressBufferSize' is the size of the first output buffer containing
-- the compressed data. If you know an approximate upper bound on the size of
-- the compressed data then setting this parameter can save memory. The default
-- compression output buffer size is @16k@. If your estimate is wrong it does
-- not matter too much, the default buffer size will be used for the remaining
-- chunks.
--
data CompressParams = CompressParams {
  CompressParams -> CompressionLevel
compressLevel       :: !Stream.CompressionLevel,
  CompressParams -> Method
compressMethod      :: !Stream.Method,
  CompressParams -> WindowBits
compressWindowBits  :: !Stream.WindowBits,
  CompressParams -> MemoryLevel
compressMemoryLevel :: !Stream.MemoryLevel,
  CompressParams -> CompressionStrategy
compressStrategy    :: !Stream.CompressionStrategy,
  CompressParams -> Int
compressBufferSize  :: !Int,
  CompressParams -> Maybe ByteString
compressDictionary  :: Maybe S.ByteString
} deriving Int -> CompressParams -> ShowS
[CompressParams] -> ShowS
CompressParams -> String
(Int -> CompressParams -> ShowS)
-> (CompressParams -> String)
-> ([CompressParams] -> ShowS)
-> Show CompressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressParams -> ShowS
showsPrec :: Int -> CompressParams -> ShowS
$cshow :: CompressParams -> String
show :: CompressParams -> String
$cshowList :: [CompressParams] -> ShowS
showList :: [CompressParams] -> ShowS
Show

-- | The full set of parameters for decompression. The defaults are
-- 'defaultDecompressParams'.
--
-- The 'decompressBufferSize' is the size of the first output buffer,
-- containing the uncompressed data. If you know an exact or approximate upper
-- bound on the size of the decompressed data then setting this parameter can
-- save memory. The default decompression output buffer size is @32k@. If your
-- estimate is wrong it does not matter too much, the default buffer size will
-- be used for the remaining chunks.
--
-- One particular use case for setting the 'decompressBufferSize' is if you
-- know the exact size of the decompressed data and want to produce a strict
-- 'Data.ByteString.ByteString'. The compression and decompression functions
-- use lazy 'Data.ByteString.Lazy.ByteString's but if you set the
-- 'decompressBufferSize' correctly then you can generate a lazy
-- 'Data.ByteString.Lazy.ByteString' with exactly one chunk, which can be
-- converted to a strict 'Data.ByteString.ByteString' in @O(1)@ time using
-- @'Data.ByteString.concat' . 'Data.ByteString.Lazy.toChunks'@.
--
data DecompressParams = DecompressParams {
  DecompressParams -> WindowBits
decompressWindowBits :: !Stream.WindowBits,
  DecompressParams -> Int
decompressBufferSize :: !Int,
  DecompressParams -> Maybe ByteString
decompressDictionary :: Maybe S.ByteString,
  DecompressParams -> Bool
decompressAllMembers :: Bool
} deriving Int -> DecompressParams -> ShowS
[DecompressParams] -> ShowS
DecompressParams -> String
(Int -> DecompressParams -> ShowS)
-> (DecompressParams -> String)
-> ([DecompressParams] -> ShowS)
-> Show DecompressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecompressParams -> ShowS
showsPrec :: Int -> DecompressParams -> ShowS
$cshow :: DecompressParams -> String
show :: DecompressParams -> String
$cshowList :: [DecompressParams] -> ShowS
showList :: [DecompressParams] -> ShowS
Show

-- | The default set of parameters for compression. This is typically used with
-- the @compressWith@ function with specific parameters overridden.
--
defaultCompressParams :: CompressParams
defaultCompressParams :: CompressParams
defaultCompressParams = CompressParams {
  compressLevel :: CompressionLevel
compressLevel       = CompressionLevel
Stream.defaultCompression,
  compressMethod :: Method
compressMethod      = Method
Stream.deflateMethod,
  compressWindowBits :: WindowBits
compressWindowBits  = WindowBits
Stream.defaultWindowBits,
  compressMemoryLevel :: MemoryLevel
compressMemoryLevel = MemoryLevel
Stream.defaultMemoryLevel,
  compressStrategy :: CompressionStrategy
compressStrategy    = CompressionStrategy
Stream.defaultStrategy,
  compressBufferSize :: Int
compressBufferSize  = Int
defaultCompressBufferSize,
  compressDictionary :: Maybe ByteString
compressDictionary  = Maybe ByteString
forall a. Maybe a
Nothing
}

-- | The default set of parameters for decompression. This is typically used with
-- the @compressWith@ function with specific parameters overridden.
--
defaultDecompressParams :: DecompressParams
defaultDecompressParams :: DecompressParams
defaultDecompressParams = DecompressParams {
  decompressWindowBits :: WindowBits
decompressWindowBits = WindowBits
Stream.defaultWindowBits,
  decompressBufferSize :: Int
decompressBufferSize = Int
defaultDecompressBufferSize,
  decompressDictionary :: Maybe ByteString
decompressDictionary = Maybe ByteString
forall a. Maybe a
Nothing,
  decompressAllMembers :: Bool
decompressAllMembers = Bool
True
}

-- | The default chunk sizes for the output of compression and decompression
-- are 16k and 32k respectively (less a small accounting overhead).
--
defaultCompressBufferSize, defaultDecompressBufferSize :: Int
defaultCompressBufferSize :: Int
defaultCompressBufferSize   = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
L.chunkOverhead
defaultDecompressBufferSize :: Int
defaultDecompressBufferSize = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
L.chunkOverhead

-- | The unfolding of the decompression process, where you provide a sequence
-- of compressed data chunks as input and receive a sequence of uncompressed
-- data chunks as output. The process is incremental, in that the demand for
-- input and provision of output are interleaved.
--
-- To indicate the end of the input supply an empty input chunk. Note that
-- for 'gzipFormat' with the default 'decompressAllMembers' @True@ you will
-- have to do this, as the decompressor will look for any following members.
-- With 'decompressAllMembers' @False@ the decompressor knows when the data
-- ends and will produce 'DecompressStreamEnd' without you having to supply an
-- empty chunk to indicate the end of the input.
--
data DecompressStream m =

     DecompressInputRequired {
         forall (m :: * -> *).
DecompressStream m -> ByteString -> m (DecompressStream m)
decompressSupplyInput :: S.ByteString -> m (DecompressStream m)
       }

   | DecompressOutputAvailable {
         forall (m :: * -> *). DecompressStream m -> ByteString
decompressOutput :: !S.ByteString,
         forall (m :: * -> *). DecompressStream m -> m (DecompressStream m)
decompressNext   :: m (DecompressStream m)
       }

   -- | Includes any trailing unconsumed /input/ data.
   | DecompressStreamEnd {
         forall (m :: * -> *). DecompressStream m -> ByteString
decompressUnconsumedInput :: S.ByteString
       }

   -- | An error code
   | DecompressStreamError {
         forall (m :: * -> *). DecompressStream m -> DecompressError
decompressStreamError :: DecompressError
       }

-- | The possible error cases when decompressing a stream.
--
-- This can be 'show'n to give a human readable error message.
--
data DecompressError =
     -- | The compressed data stream ended prematurely. This may happen if the
     -- input data stream was truncated.
     TruncatedInput

     -- | It is possible to do zlib compression with a custom dictionary. This
     -- allows slightly higher compression ratios for short files. However such
     -- compressed streams require the same dictionary when decompressing. This
     -- error is for when we encounter a compressed stream that needs a
     -- dictionary, and it's not provided.
   | DictionaryRequired

     -- | If the stream requires a dictionary and you provide one with the
     -- wrong 'DictionaryHash' then you will get this error.
   | DictionaryMismatch

     -- | If the compressed data stream is corrupted in any way then you will
     -- get this error, for example if the input data just isn't a compressed
     -- zlib data stream. In particular if the data checksum turns out to be
     -- wrong then you will get all the decompressed data but this error at the
     -- end, instead of the normal successful 'StreamEnd'.
   | DataFormatError String
  deriving (DecompressError -> DecompressError -> Bool
(DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> Bool)
-> Eq DecompressError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecompressError -> DecompressError -> Bool
== :: DecompressError -> DecompressError -> Bool
$c/= :: DecompressError -> DecompressError -> Bool
/= :: DecompressError -> DecompressError -> Bool
Eq, Typeable)

instance Show DecompressError where
  show :: DecompressError -> String
show DecompressError
TruncatedInput     = ShowS
modprefix String
"premature end of compressed data stream"
  show DecompressError
DictionaryRequired = ShowS
modprefix String
"compressed data stream requires custom dictionary"
  show DecompressError
DictionaryMismatch = ShowS
modprefix String
"given dictionary does not match the expected one"
  show (DataFormatError String
detail) = ShowS
modprefix (String
"compressed data stream format error (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
detail String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")

modprefix :: ShowS
modprefix :: ShowS
modprefix = (String
"Codec.Compression.Zlib: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Exception DecompressError

-- | A fold over the 'DecompressStream' in the given monad.
--
-- One way to look at this is that it runs the stream, using callback functions
-- for the four stream events.
--
foldDecompressStream :: Monad m
                     => ((S.ByteString -> m a) -> m a)
                     -> (S.ByteString -> m a -> m a)
                     -> (S.ByteString -> m a)
                     -> (DecompressError -> m a)
                     -> DecompressStream m -> m a
foldDecompressStream :: forall (m :: * -> *) a.
Monad m =>
((ByteString -> m a) -> m a)
-> (ByteString -> m a -> m a)
-> (ByteString -> m a)
-> (DecompressError -> m a)
-> DecompressStream m
-> m a
foldDecompressStream (ByteString -> m a) -> m a
input ByteString -> m a -> m a
output ByteString -> m a
end DecompressError -> m a
err = DecompressStream m -> m a
fold
  where
    fold :: DecompressStream m -> m a
fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) =
      (ByteString -> m a) -> m a
input (\ByteString
x -> ByteString -> m (DecompressStream m)
next ByteString
x m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream m -> m a
fold)

    fold (DecompressOutputAvailable ByteString
outchunk m (DecompressStream m)
next) =
      ByteString -> m a -> m a
output ByteString
outchunk (m (DecompressStream m)
next m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream m -> m a
fold)

    fold (DecompressStreamEnd ByteString
inchunk) = ByteString -> m a
end ByteString
inchunk
    fold (DecompressStreamError DecompressError
derr)  = DecompressError -> m a
err DecompressError
derr

-- | A variant on 'foldCompressStream' that is pure rather than operating in a
-- monad and where the input is provided by a lazy 'L.ByteString'. So we only
-- have to deal with the output, end and error parts, making it like a foldr on
-- a list of output chunks.
--
-- For example:
--
-- > toChunks = foldDecompressStreamWithInput (:) [] throw
--
foldDecompressStreamWithInput :: (S.ByteString -> a -> a)
                              -> (L.ByteString -> a)
                              -> (DecompressError -> a)
                              -> (forall s. DecompressStream (ST s))
                              -> L.ByteString
                              -> a
foldDecompressStreamWithInput :: forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
foldDecompressStreamWithInput ByteString -> a -> a
chunk ByteString -> a
end DecompressError -> a
err = \forall s. DecompressStream (ST s)
s ByteString
lbs ->
    (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (DecompressStream (ST s) -> [ByteString] -> ST s a
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> [ByteString] -> m a
fold DecompressStream (ST s)
forall s. DecompressStream (ST s)
s (ByteString -> [ByteString]
L.toChunks ByteString
lbs))
  where
    fold :: DecompressStream m -> [ByteString] -> m a
fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) [] =
      ByteString -> m (DecompressStream m)
next ByteString
S.empty m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
strm -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
strm []

    fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) (ByteString
inchunk:[ByteString]
inchunks) =
      ByteString -> m (DecompressStream m)
next ByteString
inchunk m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
s -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
s [ByteString]
inchunks

    fold (DecompressOutputAvailable ByteString
outchunk m (DecompressStream m)
next) [ByteString]
inchunks = do
      a
r <- m (DecompressStream m)
next m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
s -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
s [ByteString]
inchunks
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> a -> a
chunk ByteString
outchunk a
r

    fold (DecompressStreamEnd ByteString
inchunk) [ByteString]
inchunks =
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
end ([ByteString] -> ByteString
L.fromChunks (ByteString
inchunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
inchunks))

    fold (DecompressStreamError DecompressError
derr) [ByteString]
_ =
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ DecompressError -> a
err DecompressError
derr


-- $incremental-compression
-- The pure 'compress' and 'decompress' functions are streaming in the sense
-- that they can produce output without demanding all input, however they need
-- the input data stream as a lazy 'L.ByteString'. Having the input data
-- stream as a lazy 'L.ByteString' often requires using lazy I\/O which is not
-- appropriate in all circumstances.
--
-- For these cases an incremental interface is more appropriate. This interface
-- allows both incremental input and output. Chunks of input data are supplied
-- one by one (e.g. as they are obtained from an input source like a file or
-- network source). Output is also produced chunk by chunk.
--
-- The incremental input and output is managed via the 'CompressStream' and
-- 'DecompressStream' types. They represents the unfolding of the process of
-- compressing and decompressing. They operates in either the 'ST' or 'IO'
-- monads. They can be lifted into other incremental abstractions like pipes or
-- conduits, or they can be used directly in the following style.

-- $using-incremental-compression
--
-- In a loop:
--
--  * Inspect the status of the stream
--
--  * When it is 'CompressInputRequired' then you should call the action,
--    passing a chunk of input (or 'BS.empty' when no more input is available)
--    to get the next state of the stream and continue the loop.
--
--  * When it is 'CompressOutputAvailable' then do something with the given
--    chunk of output, and call the action to get the next state of the stream
--    and continue the loop.
--
--  * When it is 'CompressStreamEnd' then terminate the loop.
--
-- Note that you cannot stop as soon as you have no more input, you need to
-- carry on until all the output has been collected, i.e. until you get to
-- 'CompressStreamEnd'.
--
-- Here is an example where we get input from one file handle and send the
-- compressed output to another file handle.
--
-- > go :: Handle -> Handle -> CompressStream IO -> IO ()
-- > go inh outh (CompressInputRequired next) = do
-- >    inchunk <- BS.hGet inh 4096
-- >    go inh outh =<< next inchunk
-- > go inh outh (CompressOutputAvailable outchunk next) =
-- >    BS.hPut outh outchunk
-- >    go inh outh =<< next
-- > go _ _ CompressStreamEnd = return ()
--
-- The same can be achieved with 'foldCompressStream':
--
-- > foldCompressStream
-- >   (\next -> do inchunk <- BS.hGet inh 4096; next inchunk)
-- >   (\outchunk next -> do BS.hPut outh outchunk; next)
-- >   (return ())

-- $using-incremental-decompression
--
-- The use of 'DecompressStream' is very similar to 'CompressStream' but with
-- a few differences:
--
-- * There is the extra possibility of a 'DecompressStreamError'
--
-- * There can be extra trailing data after a compressed stream, and the
--   'DecompressStreamEnd' includes that.
--
-- Otherwise the same loop style applies, and there are fold functions.

-- | The unfolding of the compression process, where you provide a sequence
-- of uncompressed data chunks as input and receive a sequence of compressed
-- data chunks as output. The process is incremental, in that the demand for
-- input and provision of output are interleaved.
--
data CompressStream m =
     CompressInputRequired {
         forall (m :: * -> *).
CompressStream m -> ByteString -> m (CompressStream m)
compressSupplyInput :: S.ByteString -> m (CompressStream m)
       }

   | CompressOutputAvailable {
        forall (m :: * -> *). CompressStream m -> ByteString
compressOutput :: !S.ByteString,
        forall (m :: * -> *). CompressStream m -> m (CompressStream m)
compressNext   :: m (CompressStream m)
      }

   | CompressStreamEnd

-- | A fold over the 'CompressStream' in the given monad.
--
-- One way to look at this is that it runs the stream, using callback functions
-- for the three stream events.
--
foldCompressStream :: Monad m
                   => ((S.ByteString -> m a) -> m a)
                   -> (S.ByteString -> m a -> m a)
                   -> m a
                   -> CompressStream m -> m a
foldCompressStream :: forall (m :: * -> *) a.
Monad m =>
((ByteString -> m a) -> m a)
-> (ByteString -> m a -> m a) -> m a -> CompressStream m -> m a
foldCompressStream (ByteString -> m a) -> m a
input ByteString -> m a -> m a
output m a
end = CompressStream m -> m a
fold
  where
    fold :: CompressStream m -> m a
fold (CompressInputRequired ByteString -> m (CompressStream m)
next) =
      (ByteString -> m a) -> m a
input (\ByteString
x -> ByteString -> m (CompressStream m)
next ByteString
x m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream m -> m a
fold)

    fold (CompressOutputAvailable ByteString
outchunk m (CompressStream m)
next) =
      ByteString -> m a -> m a
output ByteString
outchunk (m (CompressStream m)
next m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream m -> m a
fold)

    fold CompressStream m
CompressStreamEnd =
      m a
end

-- | A variant on 'foldCompressStream' that is pure rather than operating in a
-- monad and where the input is provided by a lazy 'L.ByteString'. So we only
-- have to deal with the output and end parts, making it just like a foldr on a
-- list of output chunks.
--
-- For example:
--
-- > toChunks = foldCompressStreamWithInput (:) []
--
foldCompressStreamWithInput :: (S.ByteString -> a -> a)
                            -> a
                            -> (forall s. CompressStream (ST s))
                            -> L.ByteString
                            -> a
foldCompressStreamWithInput :: forall a.
(ByteString -> a -> a)
-> a -> (forall s. CompressStream (ST s)) -> ByteString -> a
foldCompressStreamWithInput ByteString -> a -> a
chunk a
end = \forall s. CompressStream (ST s)
s ByteString
lbs ->
    (forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (CompressStream (ST s) -> [ByteString] -> ST s a
forall {m :: * -> *}.
Monad m =>
CompressStream m -> [ByteString] -> m a
fold CompressStream (ST s)
forall s. CompressStream (ST s)
s (ByteString -> [ByteString]
L.toChunks ByteString
lbs))
  where
    fold :: CompressStream m -> [ByteString] -> m a
fold (CompressInputRequired ByteString -> m (CompressStream m)
next) [] =
      ByteString -> m (CompressStream m)
next ByteString
S.empty m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
strm -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
strm []

    fold (CompressInputRequired ByteString -> m (CompressStream m)
next) (ByteString
inchunk:[ByteString]
inchunks) =
      ByteString -> m (CompressStream m)
next ByteString
inchunk m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
s -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
s [ByteString]
inchunks

    fold (CompressOutputAvailable ByteString
outchunk m (CompressStream m)
next) [ByteString]
inchunks = do
      a
r <- m (CompressStream m)
next m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
s -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
s [ByteString]
inchunks
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> a -> a
chunk ByteString
outchunk a
r

    fold CompressStream m
CompressStreamEnd [ByteString]
_inchunks =
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
end


-- | Compress a data stream provided as a lazy 'L.ByteString'.
--
-- There are no expected error conditions. All input data streams are valid. It
-- is possible for unexpected errors to occur, such as running out of memory,
-- or finding the wrong version of the zlib C library, these are thrown as
-- exceptions.
--
compress   :: Stream.Format -> CompressParams -> L.ByteString -> L.ByteString

-- | Incremental compression in the 'ST' monad. Using 'ST' makes it possible
-- to write pure /lazy/ functions while making use of incremental compression.
--
compressST :: Stream.Format -> CompressParams -> CompressStream (ST s)

-- | Incremental compression in the 'IO' monad.
--
compressIO :: Stream.Format -> CompressParams -> CompressStream IO

compress :: Format -> CompressParams -> ByteString -> ByteString
compress   Format
format CompressParams
params = (ByteString -> ByteString -> ByteString)
-> ByteString
-> (forall s. CompressStream (ST s))
-> ByteString
-> ByteString
forall a.
(ByteString -> a -> a)
-> a -> (forall s. CompressStream (ST s)) -> ByteString -> a
foldCompressStreamWithInput
                             ByteString -> ByteString -> ByteString
L.Chunk ByteString
L.Empty
                             (Format -> CompressParams -> CompressStream (ST s)
forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST Format
format CompressParams
params)
compressST :: forall s. Format -> CompressParams -> CompressStream (ST s)
compressST Format
format CompressParams
params = Format -> CompressParams -> CompressStream (ST s)
forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST  Format
format CompressParams
params
compressIO :: Format -> CompressParams -> CompressStream IO
compressIO Format
format CompressParams
params = Format -> CompressParams -> CompressStream IO
compressStreamIO  Format
format CompressParams
params

compressStream :: Stream.Format -> CompressParams -> S.ByteString
               -> Stream (CompressStream Stream)
compressStream :: Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format (CompressParams CompressionLevel
compLevel Method
method WindowBits
bits MemoryLevel
memLevel
                                CompressionStrategy
strategy Int
initChunkSize Maybe ByteString
mdict) =

    \ByteString
chunk -> do
      Format
-> CompressionLevel
-> Method
-> WindowBits
-> MemoryLevel
-> CompressionStrategy
-> Stream ()
Stream.deflateInit Format
format CompressionLevel
compLevel Method
method WindowBits
bits MemoryLevel
memLevel CompressionStrategy
strategy
      Maybe ByteString -> Stream ()
setDictionary Maybe ByteString
mdict
      ByteString
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk ((ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
 -> Stream (CompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
        if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Int -> Stream (CompressStream Stream)
fillBuffers Int
20   --gzip header is 20 bytes, others even smaller
          else do
            ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 Int
length
            Int -> Stream (CompressStream Stream)
fillBuffers Int
initChunkSize

  where
    -- we flick between two states:
    --   * where one or other buffer is empty
    --       - in which case we refill one or both
    --   * where both buffers are non-empty
    --       - in which case we compress until a buffer is empty

  fillBuffers :: Int -> Stream (CompressStream Stream)
  fillBuffers :: Int -> Stream (CompressStream Stream)
fillBuffers Int
outChunkSize = do
#ifdef DEBUG
    Stream.consistencyCheck
#endif

    -- in this state there are two possibilities:
    --   * no output buffer space is available
    --       - in which case we must make more available
    --   * no input buffer is available
    --       - in which case we must supply more
    Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
    Bool
outputBufferFull <- Stream Bool
Stream.outputBufferFull

    Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
inputBufferEmpty Bool -> Bool -> Bool
|| Bool
outputBufferFull) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Bool -> Stream () -> Stream ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr Word8
outFPtr <- IO (ForeignPtr Word8) -> Stream (ForeignPtr Word8)
forall a. IO a -> Stream a
Stream.unsafeLiftIO (Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
outChunkSize)
      ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushOutputBuffer ForeignPtr Word8
outFPtr Int
0 Int
outChunkSize

    if Bool
inputBufferEmpty
      then CompressStream Stream -> Stream (CompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> Stream (CompressStream Stream))
-> CompressStream Stream -> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Stream (CompressStream Stream))
-> CompressStream Stream
forall (m :: * -> *).
(ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired ((ByteString -> Stream (CompressStream Stream))
 -> CompressStream Stream)
-> (ByteString -> Stream (CompressStream Stream))
-> CompressStream Stream
forall a b. (a -> b) -> a -> b
$ (ByteString
 -> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
 -> Stream (CompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> ByteString
-> Stream (CompressStream Stream)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ((ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
 -> ByteString -> Stream (CompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> ByteString
-> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
           if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
             then Bool -> Stream (CompressStream Stream)
drainBuffers Bool
True
             else do
                ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 Int
length
                Bool -> Stream (CompressStream Stream)
drainBuffers Bool
False
      else Bool -> Stream (CompressStream Stream)
drainBuffers Bool
False


  drainBuffers :: Bool -> Stream (CompressStream Stream)
  drainBuffers :: Bool -> Stream (CompressStream Stream)
drainBuffers Bool
lastChunk = do

    Bool
inputBufferEmpty' <- Stream Bool
Stream.inputBufferEmpty
    Bool
outputBufferFull' <- Stream Bool
Stream.outputBufferFull
    Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert(Bool -> Bool
not Bool
outputBufferFull'
       Bool -> Bool -> Bool
&& (Bool
lastChunk Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
inputBufferEmpty')) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- this invariant guarantees we can always make forward progress
    -- and that therefore a BufferError is impossible

    let flush :: Flush
flush = if Bool
lastChunk then Flush
Stream.Finish else Flush
Stream.NoFlush
    Status
status <- Flush -> Stream Status
Stream.deflate Flush
flush

    case Status
status of
      Status
Stream.Ok -> do
        Bool
outputBufferFull <- Stream Bool
Stream.outputBufferFull
        if Bool
outputBufferFull
          then do (ForeignPtr Word8
outFPtr, Int
offset, Int
length) <- Stream (ForeignPtr Word8, Int, Int)
Stream.popOutputBuffer
                  let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
                  CompressStream Stream -> Stream (CompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> Stream (CompressStream Stream))
-> CompressStream Stream -> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Stream (CompressStream Stream) -> CompressStream Stream
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (Stream (CompressStream Stream) -> CompressStream Stream)
-> Stream (CompressStream Stream) -> CompressStream Stream
forall a b. (a -> b) -> a -> b
$ do
                    Int -> Stream (CompressStream Stream)
fillBuffers Int
defaultCompressBufferSize
          else do Int -> Stream (CompressStream Stream)
fillBuffers Int
defaultCompressBufferSize

      Status
Stream.StreamEnd -> do
        Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
        Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
inputBufferEmpty (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Int
outputBufferBytesAvailable <- Stream Int
Stream.outputBufferBytesAvailable
        if Int
outputBufferBytesAvailable Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          then do (ForeignPtr Word8
outFPtr, Int
offset, Int
length) <- Stream (ForeignPtr Word8, Int, Int)
Stream.popOutputBuffer
                  let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
                  Stream ()
Stream.finalise
                  CompressStream Stream -> Stream (CompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> Stream (CompressStream Stream))
-> CompressStream Stream -> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Stream (CompressStream Stream) -> CompressStream Stream
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (CompressStream Stream -> Stream (CompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream Stream
forall (m :: * -> *). CompressStream m
CompressStreamEnd)
          else do Stream ()
Stream.finalise
                  CompressStream Stream -> Stream (CompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream Stream
forall (m :: * -> *). CompressStream m
CompressStreamEnd

      Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
        ErrorCode
Stream.BufferError  -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"BufferError should be impossible!"
        Stream.NeedDict DictionaryHash
_   -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NeedDict is impossible!"
        ErrorCode
_                   -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

  -- Set the custom dictionary, if we were provided with one
  -- and if the format supports it (zlib and raw, not gzip).
  setDictionary :: Maybe S.ByteString -> Stream ()
  setDictionary :: Maybe ByteString -> Stream ()
setDictionary (Just ByteString
dict)
    | Format -> Bool
Stream.formatSupportsDictionary Format
format = do
        Status
status <- ByteString -> Stream Status
Stream.deflateSetDictionary ByteString
dict
        case Status
status of
          Status
Stream.Ok          -> () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Stream.Error ErrorCode
_ String
msg -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
          Status
_                  -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting deflate dictionary"
  setDictionary Maybe ByteString
_ = () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Decompress a data stream provided as a lazy 'L.ByteString'.
--
-- It will throw an exception if any error is encountered in the input data.
-- If you need more control over error handling then use one the incremental
-- versions, 'decompressST' or 'decompressIO'.
--
decompress   :: Stream.Format -> DecompressParams -> L.ByteString -> L.ByteString

-- | Incremental decompression in the 'ST' monad. Using 'ST' makes it possible
-- to write pure /lazy/ functions while making use of incremental decompression.
--
decompressST :: Stream.Format -> DecompressParams -> DecompressStream (ST s)

-- | Incremental decompression in the 'IO' monad.
--
decompressIO :: Stream.Format -> DecompressParams -> DecompressStream IO

decompress :: Format -> DecompressParams -> ByteString -> ByteString
decompress   Format
format DecompressParams
params = (ByteString -> ByteString -> ByteString)
-> (ByteString -> ByteString)
-> (DecompressError -> ByteString)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> ByteString
forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
foldDecompressStreamWithInput
                               ByteString -> ByteString -> ByteString
L.Chunk (ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
L.Empty) DecompressError -> ByteString
forall a e. Exception e => e -> a
throw
                               (Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST Format
format DecompressParams
params)
decompressST :: forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressST Format
format DecompressParams
params = Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST  Format
format DecompressParams
params
decompressIO :: Format -> DecompressParams -> DecompressStream IO
decompressIO Format
format DecompressParams
params = Format -> DecompressParams -> DecompressStream IO
decompressStreamIO  Format
format DecompressParams
params


decompressStream :: Stream.Format -> DecompressParams
                 -> Bool -> S.ByteString
                 -> Stream (DecompressStream Stream)
decompressStream :: Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format (DecompressParams WindowBits
bits Int
initChunkSize Maybe ByteString
mdict Bool
allMembers)
                 Bool
resume =

    \ByteString
chunk -> do
      Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
      Bool
outputBufferFull <- Stream Bool
Stream.outputBufferFull
      Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
inputBufferEmpty (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$
        if Bool
resume then Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat Bool -> Bool -> Bool
&& Bool
allMembers) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$
                       Stream ()
Stream.inflateReset
                  else Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
outputBufferFull (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$
                       Format -> WindowBits -> Stream ()
Stream.inflateInit Format
format WindowBits
bits
      ByteString
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk ((ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
 -> Stream (DecompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
        if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then do
            -- special case to avoid demanding more input again
            -- always an error anyway
            Bool -> Stream () -> Stream ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ do
              let outChunkSize :: Int
outChunkSize = Int
1
              ForeignPtr Word8
outFPtr <- IO (ForeignPtr Word8) -> Stream (ForeignPtr Word8)
forall a. IO a -> Stream a
Stream.unsafeLiftIO (Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
outChunkSize)
              ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushOutputBuffer ForeignPtr Word8
outFPtr Int
0 Int
outChunkSize
            Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
True
          else do
            ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 Int
length
            -- Normally we start with no output buffer (so counts as full) but
            -- if we're resuming then we'll usually still have output buffer
            -- space available
            Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (if Bool -> Bool
not Bool
resume then Bool
outputBufferFull else Bool
True) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            if Bool
outputBufferFull
              then Int -> Stream (DecompressStream Stream)
fillBuffers Int
initChunkSize
              else Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
False

  where
    -- we flick between two states:
    --   * where one or other buffer is empty
    --       - in which case we refill one or both
    --   * where both buffers are non-empty
    --       - in which case we compress until a buffer is empty

  fillBuffers :: Int
              -> Stream (DecompressStream Stream)
  fillBuffers :: Int -> Stream (DecompressStream Stream)
fillBuffers Int
outChunkSize = do
#ifdef DEBUG
    Stream.consistencyCheck
#endif

    -- in this state there are two possibilities:
    --   * no output buffer space is available
    --       - in which case we must make more available
    --   * no input buffer is available
    --       - in which case we must supply more
    Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
    Bool
outputBufferFull <- Stream Bool
Stream.outputBufferFull

    Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
inputBufferEmpty Bool -> Bool -> Bool
|| Bool
outputBufferFull) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Bool -> Stream () -> Stream ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr Word8
outFPtr <- IO (ForeignPtr Word8) -> Stream (ForeignPtr Word8)
forall a. IO a -> Stream a
Stream.unsafeLiftIO (Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
outChunkSize)
      ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushOutputBuffer ForeignPtr Word8
outFPtr Int
0 Int
outChunkSize

    if Bool
inputBufferEmpty
      then DecompressStream Stream -> Stream (DecompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream Stream -> Stream (DecompressStream Stream))
-> DecompressStream Stream -> Stream (DecompressStream Stream)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Stream (DecompressStream Stream))
-> DecompressStream Stream
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> Stream (DecompressStream Stream))
 -> DecompressStream Stream)
-> (ByteString -> Stream (DecompressStream Stream))
-> DecompressStream Stream
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk ->
           ByteString
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk ((ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
 -> Stream (DecompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
             if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
               then Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
True
               else do
                 ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 Int
length
                 Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
False
      else Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
False


  drainBuffers :: Bool -> Stream (DecompressStream Stream)
  drainBuffers :: Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
lastChunk = do

    Bool
inputBufferEmpty' <- Stream Bool
Stream.inputBufferEmpty
    Bool
outputBufferFull' <- Stream Bool
Stream.outputBufferFull
    Bool -> Stream () -> Stream ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert(Bool -> Bool
not Bool
outputBufferFull'
       Bool -> Bool -> Bool
&& (Bool
lastChunk Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
inputBufferEmpty')) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- this invariant guarantees we can always make forward progress or at
    -- least if a BufferError does occur that it must be due to a premature EOF

    Status
status <- Flush -> Stream Status
Stream.inflate Flush
Stream.NoFlush

    case Status
status of
      Status
Stream.Ok -> do
        Bool
outputBufferFull <- Stream Bool
Stream.outputBufferFull
        if Bool
outputBufferFull
          then do (ForeignPtr Word8
outFPtr, Int
offset, Int
length) <- Stream (ForeignPtr Word8, Int, Int)
Stream.popOutputBuffer
                  let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
                  DecompressStream Stream -> Stream (DecompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream Stream -> Stream (DecompressStream Stream))
-> DecompressStream Stream -> Stream (DecompressStream Stream)
forall a b. (a -> b) -> a -> b
$ ByteString
-> Stream (DecompressStream Stream) -> DecompressStream Stream
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk (Stream (DecompressStream Stream) -> DecompressStream Stream)
-> Stream (DecompressStream Stream) -> DecompressStream Stream
forall a b. (a -> b) -> a -> b
$ do
                    Int -> Stream (DecompressStream Stream)
fillBuffers Int
defaultDecompressBufferSize
          else do Int -> Stream (DecompressStream Stream)
fillBuffers Int
defaultDecompressBufferSize

      Status
Stream.StreamEnd      -> do
        -- The decompressor tells us we're done.
        -- Note that there may be input bytes still available if the stream is
        -- embedded in some other data stream, so we return any trailing data.
        Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
        if Bool
inputBufferEmpty
          then do DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (ByteString -> DecompressStream Stream
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
S.empty)
          else do (ForeignPtr Word8
inFPtr, Int
offset, Int
length) <- Stream (ForeignPtr Word8, Int, Int)
Stream.popRemainingInputBuffer
                  let inchunk :: ByteString
inchunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
inFPtr Int
offset Int
length
                  DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (ByteString -> DecompressStream Stream
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
inchunk)

      Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
        ErrorCode
Stream.BufferError  -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
TruncatedInput)
        Stream.NeedDict DictionaryHash
adler -> do
          Maybe (DecompressStream Stream)
err <- DictionaryHash
-> Maybe ByteString -> Stream (Maybe (DecompressStream Stream))
setDictionary DictionaryHash
adler Maybe ByteString
mdict
          case Maybe (DecompressStream Stream)
err of
            Just DecompressStream Stream
streamErr  -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish DecompressStream Stream
streamErr
            Maybe (DecompressStream Stream)
Nothing         -> Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
lastChunk
        ErrorCode
Stream.DataError    -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError (String -> DecompressError
DataFormatError String
msg))
        ErrorCode
_                   -> String -> Stream (DecompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

  -- Note even if we end with an error we still try to flush the last chunk if
  -- there is one. The user just has to decide what they want to trust.
  finish :: DecompressStream m -> Stream (DecompressStream m)
finish DecompressStream m
end = do
    Int
outputBufferBytesAvailable <- Stream Int
Stream.outputBufferBytesAvailable
    if Int
outputBufferBytesAvailable Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then do (ForeignPtr Word8
outFPtr, Int
offset, Int
length) <- Stream (ForeignPtr Word8, Int, Int)
Stream.popOutputBuffer
              DecompressStream m -> Stream (DecompressStream m)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m (DecompressStream m) -> DecompressStream m
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable (ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length) (DecompressStream m -> m (DecompressStream m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream m
end))
      else DecompressStream m -> Stream (DecompressStream m)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream m
end

  setDictionary :: Stream.DictionaryHash -> Maybe S.ByteString
                -> Stream (Maybe (DecompressStream Stream))
  setDictionary :: DictionaryHash
-> Maybe ByteString -> Stream (Maybe (DecompressStream Stream))
setDictionary DictionaryHash
_adler Maybe ByteString
Nothing =
    Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DecompressStream Stream)
 -> Stream (Maybe (DecompressStream Stream)))
-> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a b. (a -> b) -> a -> b
$ DecompressStream Stream -> Maybe (DecompressStream Stream)
forall a. a -> Maybe a
Just (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
DictionaryRequired)
  setDictionary DictionaryHash
_adler (Just ByteString
dict) = do
    Status
status <- ByteString -> Stream Status
Stream.inflateSetDictionary ByteString
dict
    case Status
status of
      Status
Stream.Ok -> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DecompressStream Stream)
forall a. Maybe a
Nothing
      Stream.Error ErrorCode
Stream.DataError String
_   ->
        Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DecompressStream Stream)
 -> Stream (Maybe (DecompressStream Stream)))
-> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a b. (a -> b) -> a -> b
$ DecompressStream Stream -> Maybe (DecompressStream Stream)
forall a. a -> Maybe a
Just (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
DictionaryMismatch)
      Status
_ -> String -> Stream (Maybe (DecompressStream Stream))
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting inflate dictionary"


------------------------------------------------------------------------------

mkStateST :: ST s (Stream.State s)
mkStateIO :: IO (Stream.State RealWorld)
mkStateST :: forall s. ST s (State s)
mkStateST = ST s (State s) -> ST s (State s)
forall s a. ST s a -> ST s a
strictToLazyST ST s (State s)
forall s. ST s (State s)
Stream.mkState
mkStateIO :: IO (State RealWorld)
mkStateIO = ST RealWorld (State RealWorld) -> IO (State RealWorld)
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (State RealWorld)
forall s. ST s (State s)
Stream.mkState

runStreamST :: Stream a -> Stream.State s -> ST s (a, Stream.State s)
runStreamIO :: Stream a -> Stream.State RealWorld -> IO (a, Stream.State RealWorld)
runStreamST :: forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream a
strm State s
zstate = ST s (a, State s) -> ST s (a, State s)
forall s a. ST s a -> ST s a
strictToLazyST (IO () -> ST s ()
forall a s. IO a -> ST s a
Unsafe.unsafeIOToST IO ()
noDuplicate ST s () -> ST s (a, State s) -> ST s (a, State s)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream a -> State s -> ST s (a, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
Stream.runStream Stream a
strm State s
zstate)
runStreamIO :: forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream a
strm State RealWorld
zstate = ST RealWorld (a, State RealWorld) -> IO (a, State RealWorld)
forall a. ST RealWorld a -> IO a
stToIO (Stream a -> State RealWorld -> ST RealWorld (a, State RealWorld)
forall a s. Stream a -> State s -> ST s (a, State s)
Stream.runStream Stream a
strm State RealWorld
zstate)

compressStreamIO :: Stream.Format -> CompressParams -> CompressStream IO
compressStreamIO :: Format -> CompressParams -> CompressStream IO
compressStreamIO Format
format CompressParams
params =
    CompressInputRequired {
      compressSupplyInput :: ByteString -> IO (CompressStream IO)
compressSupplyInput = \ByteString
chunk -> do
        State RealWorld
zstate <- IO (State RealWorld)
mkStateIO
        let next :: ByteString -> Stream (CompressStream Stream)
next = Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format CompressParams
params
        (CompressStream Stream
strm', State RealWorld
zstate') <- Stream (CompressStream Stream)
-> State RealWorld -> IO (CompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
        CompressStream IO -> IO (CompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State RealWorld -> CompressStream IO
go CompressStream Stream
strm' State RealWorld
zstate')
    }
  where
    go :: CompressStream Stream -> Stream.State RealWorld -> CompressStream IO
    go :: CompressStream Stream -> State RealWorld -> CompressStream IO
go (CompressInputRequired ByteString -> Stream (CompressStream Stream)
next) State RealWorld
zstate =
      CompressInputRequired {
        compressSupplyInput :: ByteString -> IO (CompressStream IO)
compressSupplyInput = \ByteString
chunk -> do
          (CompressStream Stream
strm', State RealWorld
zstate') <- Stream (CompressStream Stream)
-> State RealWorld -> IO (CompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
          CompressStream IO -> IO (CompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State RealWorld -> CompressStream IO
go CompressStream Stream
strm' State RealWorld
zstate')
      }

    go (CompressOutputAvailable ByteString
chunk Stream (CompressStream Stream)
next) State RealWorld
zstate =
      ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (IO (CompressStream IO) -> CompressStream IO)
-> IO (CompressStream IO) -> CompressStream IO
forall a b. (a -> b) -> a -> b
$ do
        (CompressStream Stream
strm', State RealWorld
zstate') <- Stream (CompressStream Stream)
-> State RealWorld -> IO (CompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (CompressStream Stream)
next State RealWorld
zstate
        CompressStream IO -> IO (CompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State RealWorld -> CompressStream IO
go CompressStream Stream
strm' State RealWorld
zstate')

    go CompressStream Stream
CompressStreamEnd State RealWorld
_ = CompressStream IO
forall (m :: * -> *). CompressStream m
CompressStreamEnd

compressStreamST :: Stream.Format -> CompressParams -> CompressStream (ST s)
compressStreamST :: forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST Format
format CompressParams
params =
    CompressInputRequired {
      compressSupplyInput :: ByteString -> ST s (CompressStream (ST s))
compressSupplyInput = \ByteString
chunk -> do
        State s
zstate <- ST s (State s)
forall s. ST s (State s)
mkStateST
        let next :: ByteString -> Stream (CompressStream Stream)
next = Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format CompressParams
params
        (CompressStream Stream
strm', State s
zstate') <- Stream (CompressStream Stream)
-> State s -> ST s (CompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State s
zstate
        CompressStream (ST s) -> ST s (CompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State s -> CompressStream (ST s)
forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go CompressStream Stream
strm' State s
zstate')
    }
  where
    go :: CompressStream Stream -> Stream.State s -> CompressStream (ST s)
    go :: forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go (CompressInputRequired ByteString -> Stream (CompressStream Stream)
next) State s
zstate =
      CompressInputRequired {
        compressSupplyInput :: ByteString -> ST s (CompressStream (ST s))
compressSupplyInput = \ByteString
chunk -> do
          (CompressStream Stream
strm', State s
zstate') <- Stream (CompressStream Stream)
-> State s -> ST s (CompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State s
zstate
          CompressStream (ST s) -> ST s (CompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State s -> CompressStream (ST s)
forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go CompressStream Stream
strm' State s
zstate')
      }

    go (CompressOutputAvailable ByteString
chunk Stream (CompressStream Stream)
next) State s
zstate =
      ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (ST s (CompressStream (ST s)) -> CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ do
        (CompressStream Stream
strm', State s
zstate') <- Stream (CompressStream Stream)
-> State s -> ST s (CompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (CompressStream Stream)
next State s
zstate
        CompressStream (ST s) -> ST s (CompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompressStream Stream -> State s -> CompressStream (ST s)
forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go CompressStream Stream
strm' State s
zstate')

    go CompressStream Stream
CompressStreamEnd State s
_ = CompressStream (ST s)
forall (m :: * -> *). CompressStream m
CompressStreamEnd


decompressStreamIO :: Stream.Format -> DecompressParams -> DecompressStream IO
decompressStreamIO :: Format -> DecompressParams -> DecompressStream IO
decompressStreamIO Format
format DecompressParams
params =
      (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        State RealWorld
zstate <- IO (State RealWorld)
mkStateIO
        let next :: ByteString -> Stream (DecompressStream Stream)
next = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
False
        (DecompressStream Stream
strm', State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
        DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate' (ByteString -> Bool
S.null ByteString
chunk)
  where
    go :: DecompressStream Stream -> Stream.State RealWorld -> Bool
       -> IO (DecompressStream IO)
    go :: DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State RealWorld
zstate !Bool
_ =
      DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        (DecompressStream Stream
strm', State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
        DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate' (ByteString -> Bool
S.null ByteString
chunk)

    go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State RealWorld
zstate !Bool
eof =
      DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk (IO (DecompressStream IO) -> DecompressStream IO)
-> IO (DecompressStream IO) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ do
        (DecompressStream Stream
strm', State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
next State RealWorld
zstate
        DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate' Bool
eof

    go (DecompressStreamEnd ByteString
unconsumed) State RealWorld
zstate !Bool
eof
      | Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat
      , DecompressParams -> Bool
decompressAllMembers DecompressParams
params
      , Bool -> Bool
not Bool
eof    = ByteString -> State RealWorld -> IO (DecompressStream IO)
tryFollowingStream ByteString
unconsumed State RealWorld
zstate
      | Bool
otherwise  = ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State RealWorld
zstate

    go (DecompressStreamError DecompressError
err) State RealWorld
zstate !Bool
_ = DecompressError -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err State RealWorld
zstate

    tryFollowingStream :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
    tryFollowingStream :: ByteString -> State RealWorld -> IO (DecompressStream IO)
tryFollowingStream ByteString
chunk State RealWorld
zstate = case ByteString -> Int
S.length ByteString
chunk of
      Int
0 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State RealWorld
zstate
         Int
1 | (?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
           -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State RealWorld
zstate
         Int
1 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
            Int
0 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State RealWorld
zstate
            Int
_ -> Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk') ByteString
chunk'' State RealWorld
zstate
         Int
_    -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk' State RealWorld
zstate
      Int
1 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0    -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk State RealWorld
zstate
         Int
_    -> Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk) ByteString
chunk' State RealWorld
zstate
      Int
_       -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk State RealWorld
zstate

    checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
    checkHeaderSplit :: Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit Word8
0x1f ByteString
chunk State RealWorld
zstate
      | (?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
        let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ([Word8] -> ByteString
S.pack [Word8
0x1f, Word8
0x8b])
        if ByteString -> Int
S.length ByteString
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
          then do
            -- have to handle the remaining data in this chunk
            (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next, State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
            (DecompressStream Stream
strm', State RealWorld
zstate'') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (DecompressStream Stream)
next ((?callStack::CallStack) => ByteString -> ByteString
ByteString -> ByteString
S.tail ByteString
chunk)) State RealWorld
zstate'
            DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate'' Bool
False
          else do
            -- subtle special case when the chunk tail is empty
            -- yay for QC tests
            (DecompressStream Stream
strm, State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
            DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm State RealWorld
zstate' Bool
False
    checkHeaderSplit Word8
byte ByteString
chunk State RealWorld
zstate =
        ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd (Word8 -> ByteString -> ByteString
S.cons Word8
byte ByteString
chunk) State RealWorld
zstate

    checkHeader :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
    checkHeader :: ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk State RealWorld
zstate
      | (?callStack::CallStack) => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x1f
      , (?callStack::CallStack) => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
        let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ByteString
chunk
        (DecompressStream Stream
strm', State RealWorld
zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
        DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate' Bool
False
    checkHeader ByteString
chunk State RealWorld
zstate = ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk State RealWorld
zstate

    finaliseStreamEnd :: ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State RealWorld
zstate = do
        ((), State RealWorld)
_ <- Stream () -> State RealWorld -> IO ((), State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
        DecompressStream m -> IO (DecompressStream m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DecompressStream m
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
unconsumed)

    finaliseStreamError :: DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err State RealWorld
zstate = do
        ((), State RealWorld)
_ <- Stream () -> State RealWorld -> IO ((), State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
        DecompressStream m -> IO (DecompressStream m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressError -> DecompressStream m
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
err)


decompressStreamST :: Stream.Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST :: forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST Format
format DecompressParams
params =
      (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
 -> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        State s
zstate <- ST s (State s)
forall s. ST s (State s)
mkStateST
        let next :: ByteString -> Stream (DecompressStream Stream)
next = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
False
        (DecompressStream Stream
strm', State s
zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State s
zstate
        DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate' (ByteString -> Bool
S.null ByteString
chunk)
  where
    go :: DecompressStream Stream -> Stream.State s -> Bool
       -> ST s (DecompressStream (ST s))
    go :: forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State s
zstate !Bool
_ =
      DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
 -> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        (DecompressStream Stream
strm', State s
zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State s
zstate
        DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate' (ByteString -> Bool
S.null ByteString
chunk)

    go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State s
zstate !Bool
eof =
      DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk (ST s (DecompressStream (ST s)) -> DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ do
        (DecompressStream Stream
strm', State s
zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
next State s
zstate
        DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate' Bool
eof

    go (DecompressStreamEnd ByteString
unconsumed) State s
zstate !Bool
eof
      | Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat
      , DecompressParams -> Bool
decompressAllMembers DecompressParams
params
      , Bool -> Bool
not Bool
eof    = ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
tryFollowingStream ByteString
unconsumed State s
zstate
      | Bool
otherwise  = ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State s
zstate

    go (DecompressStreamError DecompressError
err) State s
zstate !Bool
_ = DecompressError -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
DecompressError -> State s -> ST s (DecompressStream m)
finaliseStreamError DecompressError
err State s
zstate


    tryFollowingStream :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
    tryFollowingStream :: forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
tryFollowingStream ByteString
chunk State s
zstate =
      case ByteString -> Int
S.length ByteString
chunk of
      Int
0 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
 -> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State s
zstate
         Int
1 | (?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
           -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
         Int
1 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
 -> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
            Int
0 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
            Int
_ -> Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk') ByteString
chunk'' State s
zstate
         Int
_    -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk' State s
zstate
      Int
1 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
 -> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0    -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk State s
zstate
         Int
_    -> Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk) ByteString
chunk' State s
zstate
      Int
_       -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk State s
zstate

    checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
    checkHeaderSplit :: forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit Word8
0x1f ByteString
chunk State s
zstate
      | (?callStack::CallStack) => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
        let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ([Word8] -> ByteString
S.pack [Word8
0x1f, Word8
0x8b])
        if ByteString -> Int
S.length ByteString
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
          then do
            -- have to handle the remaining data in this chunk
            (DecompressStream Stream, State s)
x <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
            let (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next, State s
zstate') = (DecompressStream Stream, State s)
x
            (DecompressStream Stream
strm', State s
zstate'') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ((?callStack::CallStack) => ByteString -> ByteString
ByteString -> ByteString
S.tail ByteString
chunk)) State s
zstate'
            DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate'' Bool
False
          else do
            -- subtle special case when the chunk tail is empty
            -- yay for QC tests
            (DecompressStream Stream
strm, State s
zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
            DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm State s
zstate' Bool
False
    checkHeaderSplit Word8
byte ByteString
chunk State s
zstate =
        ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd (Word8 -> ByteString -> ByteString
S.cons Word8
byte ByteString
chunk) State s
zstate

    checkHeader :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
    checkHeader :: forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk State s
zstate
      | (?callStack::CallStack) => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x1f
      , (?callStack::CallStack) => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
        let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ByteString
chunk
        (DecompressStream Stream
strm', State s
zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
        DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate' Bool
False
    checkHeader ByteString
chunk State s
zstate = ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk State s
zstate

    finaliseStreamEnd :: ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State s
zstate = do
        ((), State s)
_ <- Stream () -> State s -> ST s ((), State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
        DecompressStream m -> ST s (DecompressStream m)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DecompressStream m
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
unconsumed)

    finaliseStreamError :: DecompressError -> State s -> ST s (DecompressStream m)
finaliseStreamError DecompressError
err State s
zstate = do
        ((), State s)
_ <- Stream () -> State s -> ST s ((), State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
        DecompressStream m -> ST s (DecompressStream m)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressError -> DecompressStream m
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
err)