{-# LANGUAGE CPP, Rank2Types, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) 2006-2008 Duncan Coutts
-- License     :  BSD-style
--
-- Maintainer  :  duncan@haskell.org
-- Stability   :  provisional
-- Portability :  portable (H98 + FFI)
--
-- Pure stream based interface to lower level bzlib wrapper
--
-----------------------------------------------------------------------------
module Codec.Compression.BZip.Internal (
  -- * Pure interface
  compress,
  decompress,

  -- * Monadic incremental interface
  -- ** Incremental compression
  CompressStream(..),
  compressST,
  compressIO,
  foldCompressStream,
  foldCompressStreamWithInput,

  -- ** Incremental decompression
  DecompressStream(..),
  decompressST,
  decompressIO,
  foldDecompressStream,
  foldDecompressStreamWithInput,

  -- * The compression parameter types
  CompressParams(..),
  defaultCompressParams,
  DecompressParams(..),
  defaultDecompressParams,
  Stream.BlockSize(..),
  Stream.WorkFactor(..),
  Stream.MemoryLevel(..),
  ) 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 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.Typeable (Typeable)
import GHC.IO (noDuplicate)

import qualified Codec.Compression.BZip.Stream as Stream
import Codec.Compression.BZip.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 -> BlockSize
compressBlockSize   :: Stream.BlockSize,
  CompressParams -> WorkFactor
compressWorkFactor  :: Stream.WorkFactor,
  CompressParams -> Int
compressBufferSize  :: Int
} 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 -> MemoryLevel
decompressMemoryLevel :: Stream.MemoryLevel,
  DecompressParams -> Int
decompressBufferSize  :: Int
} 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 {
  compressBlockSize :: BlockSize
compressBlockSize   = BlockSize
Stream.DefaultBlockSize,
  compressWorkFactor :: WorkFactor
compressWorkFactor  = WorkFactor
Stream.DefaultWorkFactor,
  compressBufferSize :: Int
compressBufferSize  = Int
defaultCompressBufferSize
}

-- | 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 {
  decompressMemoryLevel :: MemoryLevel
decompressMemoryLevel = MemoryLevel
Stream.DefaultMemoryLevel,
  decompressBufferSize :: Int
decompressBufferSize  = Int
defaultDecompressBufferSize
}

-- | 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 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   :: CompressParams -> L.ByteString -> L.ByteString
compressST :: CompressParams -> CompressStream (ST s)
compressIO :: CompressParams -> CompressStream IO

compress :: CompressParams -> ByteString -> ByteString
compress   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
                      (CompressParams -> CompressStream (ST s)
forall s. CompressParams -> CompressStream (ST s)
compressStreamST CompressParams
params)
compressST :: forall s. CompressParams -> CompressStream (ST s)
compressST CompressParams
params = CompressParams -> CompressStream (ST s)
forall s. CompressParams -> CompressStream (ST s)
compressStreamST CompressParams
params
compressIO :: CompressParams -> CompressStream IO
compressIO CompressParams
params = CompressParams -> CompressStream IO
compressStreamIO CompressParams
params

compressStream
  :: CompressParams -> S.ByteString -> Stream (CompressStream Stream)
compressStream :: CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream (CompressParams BlockSize
blockSize WorkFactor
workFactor Int
initChunkSize) =
    \ByteString
chunk -> do
      BlockSize -> Verbosity -> WorkFactor -> Stream ()
Stream.compressInit BlockSize
blockSize Verbosity
Stream.Silent WorkFactor
workFactor
      case ByteString
chunk of
        ByteString
_ | ByteString -> Bool
S.null ByteString
chunk -> Int -> Stream (CompressStream Stream)
fillBuffers Int
14 --bzip2 header is 14 bytes
        S.PS ForeignPtr Word8
inFPtr Int
offset Int
length -> do
          ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
offset 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 outbut 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
chunk ->
           case ByteString
chunk of
           ByteString
_ | ByteString -> Bool
S.null ByteString
chunk          -> Bool -> Stream (CompressStream Stream)
drainBuffers Bool
True
           S.PS ForeignPtr Word8
inFPtr Int
offset Int
length -> do
                ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
offset 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

    let action :: Action
action = if Bool
lastChunk then Action
Stream.Finish else Action
Stream.Run
    Status
status <- Action -> Stream Status
Stream.compress Action
action

    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
S.PS 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
S.PS 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
_ String
msg -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg


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
       }

data DecompressError =
     TruncatedInput
   | DataFormatError String
   deriving (Typeable)

instance Show DecompressError where
  show :: DecompressError -> String
show DecompressError
TruncatedInput     = ShowS
modprefix String
"premature end of compressed data stream"
  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.BZip: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Exception DecompressError

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

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

decompress   :: DecompressParams -> L.ByteString -> L.ByteString
decompressST :: DecompressParams -> DecompressStream (ST s)
decompressIO :: DecompressParams -> DecompressStream IO

decompress :: DecompressParams -> ByteString -> ByteString
decompress   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
                        (DecompressParams -> DecompressStream (ST s)
forall s. DecompressParams -> DecompressStream (ST s)
decompressStreamST DecompressParams
params)
decompressST :: forall s. DecompressParams -> DecompressStream (ST s)
decompressST DecompressParams
params = DecompressParams -> DecompressStream (ST s)
forall s. DecompressParams -> DecompressStream (ST s)
decompressStreamST DecompressParams
params
decompressIO :: DecompressParams -> DecompressStream IO
decompressIO DecompressParams
params = DecompressParams -> DecompressStream IO
decompressStreamIO DecompressParams
params

decompressStream
  :: DecompressParams -> S.ByteString -> Stream (DecompressStream Stream)
decompressStream :: DecompressParams -> ByteString -> Stream (DecompressStream Stream)
decompressStream (DecompressParams MemoryLevel
memLevel Int
initChunkSize) =
    \ByteString
chunk -> do
      Verbosity -> MemoryLevel -> Stream ()
Stream.decompressInit Verbosity
Stream.Silent MemoryLevel
memLevel
      case ByteString
chunk of
        ByteString
_ | ByteString -> Bool
S.null ByteString
chunk -> Int -> Stream (DecompressStream Stream)
fillBuffers Int
4 --always an error anyway
        S.PS ForeignPtr Word8
inFPtr Int
offset Int
length -> do
          ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
offset Int
length
          Int -> Stream (DecompressStream 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 (DecompressStream Stream)
  fillBuffers :: Int -> Stream (DecompressStream Stream)
fillBuffers Int
outChunkSize = do

    -- in this state there are two possibilities:
    --   * no outbut 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 ->
           case ByteString
chunk of
             ByteString
_ | ByteString -> Bool
S.null ByteString
chunk -> Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
True
             S.PS ForeignPtr Word8
inFPtr Int
offset Int
length -> do
                ForeignPtr Word8 -> Int -> Int -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
offset 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 detect premature EOF

    Status
status <- Stream Status
Stream.decompress

    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
S.PS 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 -- We need to detect if we ran out of input:
                  Bool
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
                  if Bool
inputBufferEmpty Bool -> Bool -> Bool
&& Bool
lastChunk
                    then DecompressStream Stream -> Stream (DecompressStream Stream)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
TruncatedInput)
                    else Int -> Stream (DecompressStream Stream)
fillBuffers Int
defaultDecompressBufferSize

      Status
Stream.StreamEnd -> do
        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
S.PS 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.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

  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
S.PS 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


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

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 :: CompressParams -> CompressStream IO
compressStreamIO :: CompressParams -> CompressStream IO
compressStreamIO 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 = CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream 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 :: CompressParams -> CompressStream (ST s)
compressStreamST :: forall s. CompressParams -> CompressStream (ST s)
compressStreamST 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 = CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream 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 :: DecompressParams -> DecompressStream IO
decompressStreamIO :: DecompressParams -> DecompressStream IO
decompressStreamIO 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 = DecompressParams -> ByteString -> Stream (DecompressStream Stream)
decompressStream DecompressParams
params
        (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 -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate'
  where
    go :: DecompressStream Stream -> Stream.State RealWorld
       -> IO (DecompressStream IO)
    go :: DecompressStream Stream
-> State RealWorld -> IO (DecompressStream IO)
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State RealWorld
zstate =
      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 -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate'

    go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State RealWorld
zstate =
      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 -> IO (DecompressStream IO)
go DecompressStream Stream
strm' State RealWorld
zstate'

    go (DecompressStreamEnd ByteString
unconsumed) State RealWorld
zstate =
        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 = DecompressError -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err 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 :: DecompressParams -> DecompressStream (ST s)
decompressStreamST :: forall s. DecompressParams -> DecompressStream (ST s)
decompressStreamST 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 = DecompressParams -> ByteString -> Stream (DecompressStream Stream)
decompressStream DecompressParams
params
        (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 -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate'
  where
    go :: DecompressStream Stream -> Stream.State s
       -> ST s (DecompressStream (ST s))
    go :: forall s.
DecompressStream Stream
-> State s -> ST s (DecompressStream (ST s))
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State s
zstate =
      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 -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate'

    go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State s
zstate =
      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 -> ST s (DecompressStream (ST s))
forall s.
DecompressStream Stream
-> State s -> ST s (DecompressStream (ST s))
go DecompressStream Stream
strm' State s
zstate'

    go (DecompressStreamEnd ByteString
unconsumed) State s
zstate =
        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 = DecompressError -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
DecompressError -> State s -> ST s (DecompressStream m)
finaliseStreamError DecompressError
err 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)