{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressParams] -> ShowS
$cshowList :: [CompressParams] -> ShowS
show :: CompressParams -> String
$cshow :: CompressParams -> String
showsPrec :: Int -> CompressParams -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecompressParams] -> ShowS
$cshowList :: [DecompressParams] -> ShowS
show :: DecompressParams -> String
$cshow :: DecompressParams -> String
showsPrec :: Int -> DecompressParams -> ShowS
$cshowsPrec :: Int -> 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  = 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 = 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 forall a. Num a => a -> a -> a
* Int
1024 forall a. Num a => a -> a -> a
- Int
L.chunkOverhead
defaultDecompressBufferSize :: Int
defaultDecompressBufferSize = Int
32 forall a. Num a => a -> a -> a
* Int
1024 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecompressError -> DecompressError -> Bool
$c/= :: DecompressError -> DecompressError -> Bool
== :: DecompressError -> DecompressError -> Bool
$c== :: 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 (" forall a. [a] -> [a] -> [a]
++ String
detail forall a. [a] -> [a] -> [a]
++ String
")")

modprefix :: ShowS
modprefix :: ShowS
modprefix = (String
"Codec.Compression.Zlib: " 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 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 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 a. (forall s. ST s a) -> a
runST (forall {m :: * -> *}.
Monad m =>
DecompressStream m -> [ByteString] -> m a
fold 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 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 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 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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> a -> a
chunk ByteString
outchunk a
r

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

    fold (DecompressStreamError DecompressError
derr) [ByteString]
_ =
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 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 a. (forall s. ST s a) -> a
runST (forall {m :: * -> *}.
Monad m =>
CompressStream m -> [ByteString] -> m a
fold 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 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 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 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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> a -> a
chunk ByteString
outchunk a
r

    fold CompressStream m
CompressStreamEnd [ByteString]
_inchunks =
      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 = forall a.
(ByteString -> a -> a)
-> a -> (forall s. CompressStream (ST s)) -> ByteString -> a
foldCompressStreamWithInput
                             ByteString -> ByteString -> ByteString
L.Chunk ByteString
L.Empty
                             (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 = 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
      forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
        if Int
length 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

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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr Word8
outFPtr <- forall a. IO a -> Stream a
Stream.unsafeLiftIO (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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
           if Int
length 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
    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')) forall a b. (a -> b) -> a -> b
$ 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk 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
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
inputBufferEmpty forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Int
outputBufferBytesAvailable <- Stream Int
Stream.outputBufferBytesAvailable
        if Int
outputBufferBytesAvailable 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *). CompressStream m
CompressStreamEnd)
          else do Stream ()
Stream.finalise
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *). CompressStream m
CompressStreamEnd

      Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
        ErrorCode
Stream.BufferError  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"BufferError should be impossible!"
        Stream.NeedDict DictionaryHash
_   -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NeedDict is impossible!"
        ErrorCode
_                   -> 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          -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Stream.Error ErrorCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
          Status
_                  -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting deflate dictionary"
  setDictionary Maybe ByteString
_ = 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 = forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
foldDecompressStreamWithInput
                               ByteString -> ByteString -> ByteString
L.Chunk (forall a b. a -> b -> a
const ByteString
L.Empty) forall a e. Exception e => e -> a
throw
                               (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 = 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
      forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
inputBufferEmpty forall a b. (a -> b) -> a -> b
$
        if Bool
resume then forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Format
format forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat Bool -> Bool -> Bool
&& Bool
allMembers) forall a b. (a -> b) -> a -> b
$
                       Stream ()
Stream.inflateReset
                  else forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
outputBufferFull forall a b. (a -> b) -> a -> b
$
                       Format -> WindowBits -> Stream ()
Stream.inflateInit Format
format WindowBits
bits
      forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
        if Int
length forall a. Eq a => a -> a -> Bool
== Int
0
          then do
            -- special case to avoid demanding more input again
            -- always an error anyway
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull forall a b. (a -> b) -> a -> b
$ do
              let outChunkSize :: Int
outChunkSize = Int
1
              ForeignPtr Word8
outFPtr <- forall a. IO a -> Stream a
Stream.unsafeLiftIO (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
            forall a. (?callStack::CallStack) => Bool -> a -> a
assert (if Bool -> Bool
not Bool
resume then Bool
outputBufferFull else Bool
True) forall a b. (a -> b) -> a -> b
$ 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

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

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull forall a b. (a -> b) -> a -> b
$ do
      ForeignPtr Word8
outFPtr <- forall a. IO a -> Stream a
Stream.unsafeLiftIO (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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk ->
           forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
             if Int
length 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
    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')) forall a b. (a -> b) -> a -> b
$ 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
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk 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 forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (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
                  forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
inchunk)

      Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
        ErrorCode
Stream.BufferError  -> forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (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  -> 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    -> forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError (String -> DecompressError
DataFormatError String
msg))
        ErrorCode
_                   -> 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 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
              forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable (ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length) (forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream m
end))
      else 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 =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Stream.Error ErrorCode
Stream.DataError String
_   ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
DictionaryMismatch)
      Status
_ -> 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 = forall s a. ST s a -> ST s a
strictToLazyST forall s. ST s (State s)
Stream.mkState
mkStateIO :: IO (State RealWorld)
mkStateIO = forall a. ST RealWorld a -> IO a
stToIO 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 = forall s a. ST s a -> ST s a
strictToLazyST (forall a s. IO a -> ST s a
Unsafe.unsafeIOToST IO ()
noDuplicate forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 = forall a. ST RealWorld a -> IO a
stToIO (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') <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
        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') <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
          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 =
      forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk forall a b. (a -> b) -> a -> b
$ do
        (CompressStream Stream
strm', State RealWorld
zstate') <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (CompressStream Stream)
next State RealWorld
zstate
        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
_ = 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 <- 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') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State s
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (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') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State s
zstate
          forall (m :: * -> *) a. Monad m => a -> m a
return (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 =
      forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk forall a b. (a -> b) -> a -> b
$ do
        (CompressStream Stream
strm', State s
zstate') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (CompressStream Stream)
next State s
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go CompressStream Stream
strm' State s
zstate')

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


decompressStreamIO :: Stream.Format -> DecompressParams -> DecompressStream IO
decompressStreamIO :: Format -> DecompressParams -> DecompressStream IO
decompressStreamIO Format
format DecompressParams
params =
      forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired 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') <- 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
_ =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        (DecompressStream Stream
strm', State RealWorld
zstate') <- 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 =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk forall a b. (a -> b) -> a -> b
$ do
        (DecompressStream Stream
strm', State RealWorld
zstate') <- 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 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  = forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State RealWorld
zstate

    go (DecompressStreamError DecompressError
err) State RealWorld
zstate !Bool
_ = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0 -> forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State RealWorld
zstate
         Int
1 | (?callStack::CallStack) => ByteString -> Word8
S.head ByteString
chunk' forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
           -> forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State RealWorld
zstate
         Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
            Int
0 -> 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
S.head ByteString
chunk') ByteString
chunk'' State RealWorld
zstate
         Int
_    -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk' State RealWorld
zstate
      Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0    -> 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
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
S.head ByteString
chunk 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 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') <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
            (DecompressStream Stream
strm', State RealWorld
zstate'') <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (DecompressStream Stream)
next ((?callStack::CallStack) => 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') <- 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 =
        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
S.index ByteString
chunk Int
0 forall a. Eq a => a -> a -> Bool
== Word8
0x1f
      , (?callStack::CallStack) => ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 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') <- 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 = 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)
_ <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
unconsumed)

    finaliseStreamError :: DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err State RealWorld
zstate = do
        ((), State RealWorld)
_ <- forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 =
      forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        State s
zstate <- 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') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State s
zstate
        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
_ =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
        (DecompressStream Stream
strm', State s
zstate') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State s
zstate
        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 =
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk forall a b. (a -> b) -> a -> b
$ do
        (DecompressStream Stream
strm', State s
zstate') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
next State s
zstate
        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 forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat
      , DecompressParams -> Bool
decompressAllMembers DecompressParams
params
      , Bool -> Bool
not Bool
eof    = forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
tryFollowingStream ByteString
unconsumed State s
zstate
      | Bool
otherwise  = forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State s
zstate

    go (DecompressStreamError DecompressError
err) State s
zstate !Bool
_ = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0 -> forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State s
zstate
         Int
1 | (?callStack::CallStack) => ByteString -> Word8
S.head ByteString
chunk' forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
           -> forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
         Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
            Int
0 -> forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
            Int
_ -> forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
S.head ByteString
chunk') ByteString
chunk'' State s
zstate
         Int
_    -> forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk' State s
zstate
      Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
         Int
0    -> forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk State s
zstate
         Int
_    -> forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit ((?callStack::CallStack) => ByteString -> Word8
S.head ByteString
chunk) ByteString
chunk' State s
zstate
      Int
_       -> 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
S.head ByteString
chunk 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 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 <- 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'') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ((?callStack::CallStack) => ByteString -> ByteString
S.tail ByteString
chunk)) State s
zstate'
            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') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
            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 =
        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
S.index ByteString
chunk Int
0 forall a. Eq a => a -> a -> Bool
== Word8
0x1f
      , (?callStack::CallStack) => ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 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') <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
        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 = 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)
_ <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (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)
_ <- forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
err)