{-# LINE 1 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CApiFFI #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) 2006-2015 Duncan Coutts
-- License     :  BSD-style
--
-- Maintainer  :  duncan@community.haskell.org
--
-- Zlib wrapper layer
--
-----------------------------------------------------------------------------
module Codec.Compression.Zlib.Stream (

  -- * The Zlib state monad
  Stream,
  State,
  mkState,
  runStream,
  unsafeLiftIO,
  finalise,

  -- * Initialisation
  deflateInit, 
  inflateInit,

  -- ** Initialisation parameters
  Format,
    gzipFormat,
    zlibFormat,
    rawFormat,
    gzipOrZlibFormat,
    formatSupportsDictionary,
  CompressionLevel(..),
    defaultCompression,
    noCompression,
    bestSpeed,
    bestCompression,
    compressionLevel,
  Method,
    deflateMethod,
  WindowBits(..),
    defaultWindowBits,
    windowBits,
  MemoryLevel(..),
    defaultMemoryLevel,
    minMemoryLevel,
    maxMemoryLevel,
    memoryLevel,
  CompressionStrategy,
    defaultStrategy,
    filteredStrategy,
    huffmanOnlyStrategy,
    rleStrategy,
    fixedStrategy,

  -- * The business
  deflate,
  inflate,
  Status(..),
  Flush(..),
  ErrorCode(..),
  -- ** Special operations
  inflateReset,

  -- * Buffer management
  -- ** Input buffer
  pushInputBuffer,
  inputBufferEmpty,
  popRemainingInputBuffer,

  -- ** Output buffer
  pushOutputBuffer,
  popOutputBuffer,
  outputBufferBytesAvailable,
  outputBufferSpaceRemaining,
  outputBufferFull,

  -- ** Dictionary
  deflateSetDictionary,
  inflateSetDictionary,

  -- ** Dictionary hashes
  DictionaryHash,
  dictionaryHash,
  zeroDictionaryHash,


{-# LINE 95 "Codec/Compression/Zlib/Stream.hsc" #-}

  ) where

import Foreign
         ( Word8, Ptr, nullPtr, plusPtr, castPtr, peekByteOff, pokeByteOff
         , ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer
         , withForeignPtr, touchForeignPtr, minusPtr )
import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )
import System.IO.Unsafe          ( unsafePerformIO )
import Foreign
         ( finalizeForeignPtr )
import Foreign.C

{-# LINE 108 "Codec/Compression/Zlib/Stream.hsc" #-}
import Foreign.C.ConstPtr

{-# LINE 110 "Codec/Compression/Zlib/Stream.hsc" #-}
import Data.ByteString.Internal (nullForeignPtr)
import qualified Data.ByteString.Unsafe as B
import Data.ByteString (ByteString)
import Control.Applicative (Applicative(..))
import Control.Monad (ap,liftM)
import qualified Control.Monad.Fail as Fail
import Control.Monad.ST.Strict
import Control.Monad.ST.Unsafe
import Control.Exception (assert)
import Data.Bits (toIntegralSized)
import Data.Coerce (coerce)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)

{-# LINE 126 "Codec/Compression/Zlib/Stream.hsc" #-}

import Prelude hiding (length, Applicative(..))




pushInputBuffer :: ForeignPtr Word8 -> Int -> CUInt -> Stream ()
pushInputBuffer :: ForeignPtr Word8 -> Int -> CUInt -> Stream ()
pushInputBuffer ForeignPtr Word8
inBuf' Int
offset CUInt
length = do

  -- must not push a new input buffer if the last one is not used up
  Int
inAvail <- Stream Int
getInAvail
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
inAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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 ()

  -- Now that we're setting a new input buffer, we can be sure that zlib no
  -- longer has a reference to the old one. Therefore this is the last point
  -- at which the old buffer had to be retained. It's safe to release now.
  ForeignPtr Word8
inBuf <- Stream (ForeignPtr Word8)
getInBuf 
  IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> IO () -> Stream ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
inBuf    

  -- now set the available input buffer ptr and length
  ForeignPtr Word8 -> Stream ()
setInBuf   ForeignPtr Word8
inBuf'
  CUInt -> Stream ()
setInAvail CUInt
length
  Ptr Word8 -> Stream ()
setInNext  (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
inBuf' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
  -- Note the 'unsafe'. We are passing the raw ptr inside inBuf' to zlib.
  -- To make this safe we need to hold on to the ForeignPtr for at least as
  -- long as zlib is using the underlying raw ptr.


inputBufferEmpty :: Stream Bool
inputBufferEmpty :: Stream Bool
inputBufferEmpty = Stream Int
getInAvail Stream Int -> (Int -> Stream Bool) -> Stream Bool
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream Bool
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Stream Bool) -> (Int -> Bool) -> Int -> Stream Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)


popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popRemainingInputBuffer = do

  ForeignPtr Word8
inBuf    <- Stream (ForeignPtr Word8)
getInBuf
  Ptr Word8
inNext   <- Stream (Ptr Word8)
getInNext
  Int
inAvail  <- Stream Int
getInAvail

  -- there really should be something to pop, otherwise it's silly
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
inAvail Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (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 ()
  CUInt -> Stream ()
setInAvail CUInt
0

  (ForeignPtr Word8, Int, Int) -> Stream (ForeignPtr Word8, Int, Int)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, Ptr Word8
inNext Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
inBuf, Int
inAvail)


pushOutputBuffer :: ForeignPtr Word8 -> Int -> CUInt -> Stream ()
pushOutputBuffer :: ForeignPtr Word8 -> Int -> CUInt -> Stream ()
pushOutputBuffer ForeignPtr Word8
outBuf' Int
offset CUInt
length = do

  --must not push a new buffer if there is still data in the old one
  Int
outAvail <- Stream Int
getOutAvail
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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 ()
  -- Note that there may still be free space in the output buffer, that's ok,
  -- you might not want to bother completely filling the output buffer say if
  -- there's only a few free bytes left.

  ForeignPtr Word8
outBuf <- Stream (ForeignPtr Word8)
getOutBuf
  IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> IO () -> Stream ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
outBuf

  -- now set the available input buffer ptr and length
  ForeignPtr Word8 -> Stream ()
setOutBuf  ForeignPtr Word8
outBuf'
  CUInt -> Stream ()
setOutFree CUInt
length
  Ptr Word8 -> Stream ()
setOutNext (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
outBuf' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)

  Int -> Stream ()
setOutOffset Int
offset
  Int -> Stream ()
setOutAvail  Int
0


-- get that part of the output buffer that is currently full
-- (might be 0, use outputBufferBytesAvailable to check)
-- this may leave some space remaining in the buffer, use
-- outputBufferSpaceRemaining to check.
popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popOutputBuffer = do

  ForeignPtr Word8
outBuf    <- Stream (ForeignPtr Word8)
getOutBuf
  Int
outOffset <- Stream Int
getOutOffset
  Int
outAvail  <- Stream Int
getOutAvail

  -- there really should be something to pop, otherwise it's silly
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (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 -> Stream ()
setOutOffset (Int
outOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outAvail)
  Int -> Stream ()
setOutAvail  Int
0

  (ForeignPtr Word8, Int, Int) -> Stream (ForeignPtr Word8, Int, Int)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
outBuf, Int
outOffset, Int
outAvail)


-- this is the number of bytes available in the output buffer
outputBufferBytesAvailable :: Stream Int
outputBufferBytesAvailable :: Stream Int
outputBufferBytesAvailable = Stream Int
getOutAvail


-- you needn't get all the output immediately, you can continue until
-- there is no more output space available, this tells you that amount
outputBufferSpaceRemaining :: Stream Int
outputBufferSpaceRemaining :: Stream Int
outputBufferSpaceRemaining = Stream Int
getOutFree


-- you only need to supply a new buffer when there is no more output buffer
-- space remaining
outputBufferFull :: Stream Bool
outputBufferFull :: Stream Bool
outputBufferFull = (Int -> Bool) -> Stream Int -> Stream Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0) Stream Int
outputBufferSpaceRemaining


-- you can only run this when the output buffer is not empty
-- you can run it when the input buffer is empty but it doesn't do anything
-- after running deflate either the output buffer will be full
-- or the input buffer will be empty (or both)
deflate :: Flush -> Stream Status
deflate :: Flush -> Stream Status
deflate Flush
flush = do

  Int
outFree <- Stream Int
getOutFree

  -- deflate needs free space in the output buffer
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outFree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (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 ()

  Status
result <- Flush -> Stream Status
deflate_ Flush
flush
  Int
outFree' <- Stream Int
getOutFree
    
  -- number of bytes of extra output there is available as a result of
  -- the call to deflate:
  let outExtra :: Int
outExtra = Int
outFree Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
outFree'
  
  Int
outAvail <- Stream Int
getOutAvail
  Int -> Stream ()
setOutAvail (Int
outAvail Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outExtra)
  Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result


inflate :: Flush -> Stream Status
inflate :: Flush -> Stream Status
inflate Flush
flush = do

  Int
outFree <- Stream Int
getOutFree

  -- inflate needs free space in the output buffer
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outFree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (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 ()

  Status
result <- Flush -> Stream Status
inflate_ Flush
flush
  Int
outFree' <- Stream Int
getOutFree

  -- number of bytes of extra output there is available as a result of
  -- the call to inflate:
  let outExtra :: Int
outExtra = Int
outFree Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
outFree'

  Int
outAvail <- Stream Int
getOutAvail
  Int -> Stream ()
setOutAvail (Int
outAvail Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outExtra)
  Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result


inflateReset :: Stream ()
inflateReset :: Stream ()
inflateReset = do

  Int
outAvail <- Stream Int
getOutAvail
  Int
inAvail  <- Stream Int
getInAvail
  -- At the point where this is used, all the output should have been consumed
  -- and any trailing input should be extracted and resupplied explicitly, not
  -- just left.
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
inAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (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 ()

  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
    StreamState -> IO CInt
c_inflateReset StreamState
zstream
  CInt -> Stream ()
failIfError CInt
err


-- | Dictionary length must fit into t'CUInt'.
deflateSetDictionary :: ByteString -> Stream Status
deflateSetDictionary :: ByteString -> Stream Status
deflateSetDictionary ByteString
dict = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
           ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
dict ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
             StreamState -> Ptr CUChar -> CUInt -> IO CInt
c_deflateSetDictionary StreamState
zstream (CString -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CUInt
int2cuint Int
len)
  CInt -> Stream Status
toStatus CInt
err

-- | Dictionary length must fit into t'CUInt'.
inflateSetDictionary :: ByteString -> Stream Status
inflateSetDictionary :: ByteString -> Stream Status
inflateSetDictionary ByteString
dict = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream -> do
           ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
dict ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
             StreamState -> Ptr CUChar -> CUInt -> IO CInt
c_inflateSetDictionary StreamState
zstream (CString -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CUInt
int2cuint Int
len)
  CInt -> Stream Status
toStatus CInt
err

-- | A hash of a custom compression dictionary. These hashes are used by
-- zlib as dictionary identifiers.
-- (The particular hash function used is Adler32.)
--
newtype DictionaryHash = DictHash CULong
  deriving (DictionaryHash -> DictionaryHash -> Bool
(DictionaryHash -> DictionaryHash -> Bool)
-> (DictionaryHash -> DictionaryHash -> Bool) -> Eq DictionaryHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DictionaryHash -> DictionaryHash -> Bool
== :: DictionaryHash -> DictionaryHash -> Bool
$c/= :: DictionaryHash -> DictionaryHash -> Bool
/= :: DictionaryHash -> DictionaryHash -> Bool
Eq, Eq DictionaryHash
Eq DictionaryHash =>
(DictionaryHash -> DictionaryHash -> Ordering)
-> (DictionaryHash -> DictionaryHash -> Bool)
-> (DictionaryHash -> DictionaryHash -> Bool)
-> (DictionaryHash -> DictionaryHash -> Bool)
-> (DictionaryHash -> DictionaryHash -> Bool)
-> (DictionaryHash -> DictionaryHash -> DictionaryHash)
-> (DictionaryHash -> DictionaryHash -> DictionaryHash)
-> Ord DictionaryHash
DictionaryHash -> DictionaryHash -> Bool
DictionaryHash -> DictionaryHash -> Ordering
DictionaryHash -> DictionaryHash -> DictionaryHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DictionaryHash -> DictionaryHash -> Ordering
compare :: DictionaryHash -> DictionaryHash -> Ordering
$c< :: DictionaryHash -> DictionaryHash -> Bool
< :: DictionaryHash -> DictionaryHash -> Bool
$c<= :: DictionaryHash -> DictionaryHash -> Bool
<= :: DictionaryHash -> DictionaryHash -> Bool
$c> :: DictionaryHash -> DictionaryHash -> Bool
> :: DictionaryHash -> DictionaryHash -> Bool
$c>= :: DictionaryHash -> DictionaryHash -> Bool
>= :: DictionaryHash -> DictionaryHash -> Bool
$cmax :: DictionaryHash -> DictionaryHash -> DictionaryHash
max :: DictionaryHash -> DictionaryHash -> DictionaryHash
$cmin :: DictionaryHash -> DictionaryHash -> DictionaryHash
min :: DictionaryHash -> DictionaryHash -> DictionaryHash
Ord, ReadPrec [DictionaryHash]
ReadPrec DictionaryHash
Int -> ReadS DictionaryHash
ReadS [DictionaryHash]
(Int -> ReadS DictionaryHash)
-> ReadS [DictionaryHash]
-> ReadPrec DictionaryHash
-> ReadPrec [DictionaryHash]
-> Read DictionaryHash
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DictionaryHash
readsPrec :: Int -> ReadS DictionaryHash
$creadList :: ReadS [DictionaryHash]
readList :: ReadS [DictionaryHash]
$creadPrec :: ReadPrec DictionaryHash
readPrec :: ReadPrec DictionaryHash
$creadListPrec :: ReadPrec [DictionaryHash]
readListPrec :: ReadPrec [DictionaryHash]
Read, Int -> DictionaryHash -> ShowS
[DictionaryHash] -> ShowS
DictionaryHash -> String
(Int -> DictionaryHash -> ShowS)
-> (DictionaryHash -> String)
-> ([DictionaryHash] -> ShowS)
-> Show DictionaryHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DictionaryHash -> ShowS
showsPrec :: Int -> DictionaryHash -> ShowS
$cshow :: DictionaryHash -> String
show :: DictionaryHash -> String
$cshowList :: [DictionaryHash] -> ShowS
showList :: [DictionaryHash] -> ShowS
Show)

-- | Update a running 'DictionaryHash'. You can generate a 'DictionaryHash'
-- from one or more 'ByteString's by starting from 'zeroDictionaryHash', e.g.
--
-- > dictionaryHash zeroDictionaryHash :: ByteString -> DictionaryHash
--
-- or
--
-- > foldl' dictionaryHash zeroDictionaryHash :: [ByteString] -> DictionaryHash
--
-- Dictionary length must fit into t'CUInt'.
dictionaryHash :: DictionaryHash -> ByteString -> DictionaryHash
dictionaryHash :: DictionaryHash -> ByteString -> DictionaryHash
dictionaryHash (DictHash CULong
adler) ByteString
dict =
  IO DictionaryHash -> DictionaryHash
forall a. IO a -> a
unsafePerformIO (IO DictionaryHash -> DictionaryHash)
-> IO DictionaryHash -> DictionaryHash
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CStringLen -> IO DictionaryHash) -> IO DictionaryHash
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
dict ((CStringLen -> IO DictionaryHash) -> IO DictionaryHash)
-> (CStringLen -> IO DictionaryHash) -> IO DictionaryHash
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
      (CULong -> DictionaryHash) -> IO CULong -> IO DictionaryHash
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CULong -> DictionaryHash
DictHash (IO CULong -> IO DictionaryHash) -> IO CULong -> IO DictionaryHash
forall a b. (a -> b) -> a -> b
$ CULong -> Ptr CUChar -> CUInt -> IO CULong
c_adler32 CULong
adler (CString -> Ptr CUChar
forall a b. Ptr a -> Ptr b
castPtr CString
ptr) (Int -> CUInt
int2cuint Int
len)

-- | A zero 'DictionaryHash' to use as the initial value with 'dictionaryHash'.
--
zeroDictionaryHash :: DictionaryHash
zeroDictionaryHash :: DictionaryHash
zeroDictionaryHash = CULong -> DictionaryHash
DictHash CULong
0

----------------------------
-- Stream monad
--

newtype Stream a = Z {
    forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ :: ForeignPtr StreamState
        -> ForeignPtr Word8
        -> ForeignPtr Word8
        -> Int -> Int
        -> IO (ForeignPtr Word8
              ,ForeignPtr Word8
              ,Int, Int, a)
  }

instance Functor Stream where
  fmap :: forall a b. (a -> b) -> Stream a -> Stream b
fmap   = (a -> b) -> Stream a -> Stream b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Stream where
  pure :: forall a. a -> Stream a
pure   = a -> Stream a
forall a. a -> Stream a
returnZ
  <*> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
(<*>)  = Stream (a -> b) -> Stream a -> Stream b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  *> :: forall a b. Stream a -> Stream b -> Stream b
(*>)   = Stream a -> Stream b -> Stream b
forall a b. Stream a -> Stream b -> Stream b
thenZ_

instance Monad Stream where
  >>= :: forall a b. Stream a -> (a -> Stream b) -> Stream b
(>>=)  = Stream a -> (a -> Stream b) -> Stream b
forall a b. Stream a -> (a -> Stream b) -> Stream b
thenZ
--  m >>= f = (m `thenZ` \a -> consistencyCheck `thenZ_` returnZ a) `thenZ` f
  >> :: forall a b. Stream a -> Stream b -> Stream b
(>>)   = Stream a -> Stream b -> Stream b
forall a b. Stream a -> Stream b -> Stream b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)


{-# LINE 364 "Codec/Compression/Zlib/Stream.hsc" #-}

instance Fail.MonadFail Stream where
  fail :: forall a. String -> Stream a
fail   = (Stream ()
finalise Stream () -> Stream a -> Stream a
forall a b. Stream a -> Stream b -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Stream a -> Stream a)
-> (String -> Stream a) -> String -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Stream a
forall a. String -> Stream a
failZ

returnZ :: a -> Stream a
returnZ :: forall a. a -> Stream a
returnZ a
a = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
 -> Stream a)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_ ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
                  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, a
a)
{-# INLINE returnZ #-}

thenZ :: Stream a -> (a -> Stream b) -> Stream b
thenZ :: forall a b. Stream a -> (a -> Stream b) -> Stream b
thenZ (Z ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) a -> Stream b
f =
  (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
 -> Stream b)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
a) ->
        Stream b
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ (a -> Stream b
f a
a) ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength'
{-# INLINE thenZ #-}

thenZ_ :: Stream a -> Stream b -> Stream b
thenZ_ :: forall a b. Stream a -> Stream b -> Stream b
thenZ_ (Z ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) Stream b
f =
  (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
 -> Stream b)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
_) ->
        Stream b
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ Stream b
f ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength'
{-# INLINE thenZ_ #-}

failZ :: String -> Stream a
failZ :: forall a. String -> Stream a
failZ String
msg = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z (\ForeignPtr StreamState
_ ForeignPtr Word8
_ ForeignPtr Word8
_ Int
_ Int
_ -> String -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Codec.Compression.Zlib: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg))

data State s = State !(ForeignPtr StreamState)
                     !(ForeignPtr Word8)
                     !(ForeignPtr Word8)
      {-# UNPACK #-} !Int
      {-# UNPACK #-} !Int

mkState :: ST s (State s)
mkState :: forall s. ST s (State s)
mkState = IO (State s) -> ST s (State s)
forall a s. IO a -> ST s a
unsafeIOToST (IO (State s) -> ST s (State s)) -> IO (State s) -> ST s (State s)
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr StreamState
stream <- Int -> IO (ForeignPtr StreamState)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
112)
{-# LINE 401 "Codec/Compression/Zlib/Stream.hsc" #-}
  withForeignPtr stream $ \ptr -> do
    (\hsc_ptr -> pokeByteOff hsc_ptr 48)       ptr nullPtr
{-# LINE 403 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 64)    ptr nullPtr
{-# LINE 404 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 72)     ptr nullPtr
{-# LINE 405 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 80)    ptr nullPtr
{-# LINE 406 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)   ptr nullPtr
{-# LINE 407 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24)  ptr nullPtr
{-# LINE 408 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (0 :: CUInt)
{-# LINE 409 "Codec/Compression/Zlib/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (0 :: CUInt)
{-# LINE 410 "Codec/Compression/Zlib/Stream.hsc" #-}
  return (State stream nullForeignPtr nullForeignPtr 0 0)

runStream :: Stream a -> State s -> ST s (a, State s)
runStream :: forall a s. Stream a -> State s -> ST s (a, State s)
runStream (Z ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) (State ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength) =
  IO (a, State s) -> ST s (a, State s)
forall a s. IO a -> ST s a
unsafeIOToST (IO (a, State s) -> ST s (a, State s))
-> IO (a, State s) -> ST s (a, State s)
forall a b. (a -> b) -> a -> b
$
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (a, State s))
-> IO (a, State s)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
a) ->
        (a, State s) -> IO (a, State s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ForeignPtr StreamState
-> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> Int -> State s
forall s.
ForeignPtr StreamState
-> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> Int -> State s
State ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength')

-- This is marked as unsafe because runStream uses unsafeIOToST so anything
-- lifted here can end up being unsafePerformIO'd.
unsafeLiftIO :: IO a -> Stream a
unsafeLiftIO :: forall a. IO a -> Stream a
unsafeLiftIO IO a
m = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
 -> Stream a)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  a
a <- IO a
m
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, a
a)

getStreamState :: Stream (ForeignPtr StreamState)
getStreamState :: Stream (ForeignPtr StreamState)
getStreamState = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
       ForeignPtr StreamState))
-> Stream (ForeignPtr StreamState)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
        ForeignPtr StreamState))
 -> Stream (ForeignPtr StreamState))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
          ForeignPtr StreamState))
-> Stream (ForeignPtr StreamState)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
 ForeignPtr StreamState)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
      ForeignPtr StreamState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr StreamState
stream)

getInBuf :: Stream (ForeignPtr Word8)
getInBuf :: Stream (ForeignPtr Word8)
getInBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
 -> Stream (ForeignPtr Word8))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr Word8
inBuf)

getOutBuf :: Stream (ForeignPtr Word8)
getOutBuf :: Stream (ForeignPtr Word8)
getOutBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
 -> Stream (ForeignPtr Word8))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr Word8
outBuf)

getOutOffset :: Stream Int
getOutOffset :: Stream Int
getOutOffset = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
 -> Stream Int)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, Int
outOffset)

getOutAvail :: Stream Int
getOutAvail :: Stream Int
getOutAvail = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
 -> Stream Int)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, Int
outLength)

setInBuf :: ForeignPtr Word8 -> Stream ()
setInBuf :: ForeignPtr Word8 -> Stream ()
setInBuf ForeignPtr Word8
inBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
_ ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutBuf :: ForeignPtr Word8 -> Stream ()
setOutBuf :: ForeignPtr Word8 -> Stream ()
setOutBuf ForeignPtr Word8
outBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
_ Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutOffset :: Int -> Stream ()
setOutOffset :: Int -> Stream ()
setOutOffset Int
outOffset = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
_ Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutAvail :: Int -> Stream ()
setOutAvail :: Int -> Stream ()
setOutAvail Int
outLength = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
Z ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
_ -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

----------------------------
-- Debug stuff
--


{-# LINE 505 "Codec/Compression/Zlib/Stream.hsc" #-}


----------------------------
-- zlib wrapper layer
--

data Status =
    Ok
  | StreamEnd
  | Error ErrorCode String

data ErrorCode =
    NeedDict DictionaryHash
  | FileError
  | StreamError
  | DataError
  | MemoryError
  | BufferError -- ^ No progress was possible or there was not enough room in
                --   the output buffer when 'Finish' is used. Note that
                --   'BufferError' is not fatal, and 'inflate' can be called
                --   again with more input and more output space to continue.
  | VersionError
  | Unexpected

toStatus :: CInt -> Stream Status
toStatus :: CInt -> Stream Status
toStatus CInt
errno = case CInt
errno of
  (CInt
0)            -> Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Ok
{-# LINE 532 "Codec/Compression/Zlib/Stream.hsc" #-}
  (1)    -> return StreamEnd
{-# LINE 533 "Codec/Compression/Zlib/Stream.hsc" #-}
  (2)     -> do
{-# LINE 534 "Codec/Compression/Zlib/Stream.hsc" #-}
    adler <- withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 96))
{-# LINE 535 "Codec/Compression/Zlib/Stream.hsc" #-}
    err (NeedDict (DictHash adler))  "custom dictionary needed"
  (-5)     -> ErrorCode -> String -> Stream Status
err ErrorCode
BufferError  String
"buffer error"
{-# LINE 537 "Codec/Compression/Zlib/Stream.hsc" #-}
  (-1)         -> err FileError    "file error"
{-# LINE 538 "Codec/Compression/Zlib/Stream.hsc" #-}
  (-2)  -> err StreamError  "stream error"
{-# LINE 539 "Codec/Compression/Zlib/Stream.hsc" #-}
  (-3)    -> err DataError    "data error"
{-# LINE 540 "Codec/Compression/Zlib/Stream.hsc" #-}
  (-4)     -> err MemoryError  "insufficient memory"
{-# LINE 541 "Codec/Compression/Zlib/Stream.hsc" #-}
  (-6) -> err VersionError "incompatible zlib version"
{-# LINE 542 "Codec/Compression/Zlib/Stream.hsc" #-}
  other                      -> return $ Error Unexpected
                                  ("unexpected zlib status: " ++ show other)
 where
   err :: ErrorCode -> String -> Stream Status
err ErrorCode
errCode String
altMsg = (String -> Status) -> Stream String -> Stream Status
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ErrorCode -> String -> Status
Error ErrorCode
errCode) (Stream String -> Stream Status) -> Stream String -> Stream Status
forall a b. (a -> b) -> a -> b
$ do
    CString
msgPtr <- (Ptr StreamState -> IO CString) -> Stream CString
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
48))
{-# LINE 547 "Codec/Compression/Zlib/Stream.hsc" #-}
    if msgPtr /= nullPtr
     then unsafeLiftIO (peekCAString msgPtr)
     else return altMsg

failIfError :: CInt -> Stream ()
failIfError :: CInt -> Stream ()
failIfError CInt
errno = CInt -> Stream Status
toStatus CInt
errno Stream Status -> (Status -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
status -> case Status
status of
  (Error ErrorCode
_ String
msg) -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
  Status
_             -> () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


data Flush =
    NoFlush
  | SyncFlush
  | FullFlush
  | Finish
  | Block

fromFlush :: Flush -> CInt
fromFlush :: Flush -> CInt
fromFlush Flush
NoFlush   = CInt
0
{-# LINE 566 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush SyncFlush = 2
{-# LINE 567 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush FullFlush = 3
{-# LINE 568 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush Finish    = 4
{-# LINE 569 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush Block     = 5
{-# LINE 570 "Codec/Compression/Zlib/Stream.hsc" #-}


-- | The format used for compression or decompression. There are three
-- variations.
--
data Format = GZip | Zlib | Raw | GZipOrZlib
  deriving (Format -> Format -> Bool
(Format -> Format -> Bool)
-> (Format -> Format -> Bool) -> Eq Format
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
/= :: Format -> Format -> Bool
Eq, Eq Format
Eq Format =>
(Format -> Format -> Ordering)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Bool)
-> (Format -> Format -> Format)
-> (Format -> Format -> Format)
-> Ord Format
Format -> Format -> Bool
Format -> Format -> Ordering
Format -> Format -> Format
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Format -> Format -> Ordering
compare :: Format -> Format -> Ordering
$c< :: Format -> Format -> Bool
< :: Format -> Format -> Bool
$c<= :: Format -> Format -> Bool
<= :: Format -> Format -> Bool
$c> :: Format -> Format -> Bool
> :: Format -> Format -> Bool
$c>= :: Format -> Format -> Bool
>= :: Format -> Format -> Bool
$cmax :: Format -> Format -> Format
max :: Format -> Format -> Format
$cmin :: Format -> Format -> Format
min :: Format -> Format -> Format
Ord, Int -> Format
Format -> Int
Format -> [Format]
Format -> Format
Format -> Format -> [Format]
Format -> Format -> Format -> [Format]
(Format -> Format)
-> (Format -> Format)
-> (Int -> Format)
-> (Format -> Int)
-> (Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> [Format])
-> (Format -> Format -> Format -> [Format])
-> Enum Format
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Format -> Format
succ :: Format -> Format
$cpred :: Format -> Format
pred :: Format -> Format
$ctoEnum :: Int -> Format
toEnum :: Int -> Format
$cfromEnum :: Format -> Int
fromEnum :: Format -> Int
$cenumFrom :: Format -> [Format]
enumFrom :: Format -> [Format]
$cenumFromThen :: Format -> Format -> [Format]
enumFromThen :: Format -> Format -> [Format]
$cenumFromTo :: Format -> Format -> [Format]
enumFromTo :: Format -> Format -> [Format]
$cenumFromThenTo :: Format -> Format -> Format -> [Format]
enumFromThenTo :: Format -> Format -> Format -> [Format]
Enum, Format
Format -> Format -> Bounded Format
forall a. a -> a -> Bounded a
$cminBound :: Format
minBound :: Format
$cmaxBound :: Format
maxBound :: Format
Bounded, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Format -> ShowS
showsPrec :: Int -> Format -> ShowS
$cshow :: Format -> String
show :: Format -> String
$cshowList :: [Format] -> ShowS
showList :: [Format] -> ShowS
Show
              , (forall x. Format -> Rep Format x)
-> (forall x. Rep Format x -> Format) -> Generic Format
forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Format -> Rep Format x
from :: forall x. Format -> Rep Format x
$cto :: forall x. Rep Format x -> Format
to :: forall x. Rep Format x -> Format
Generic
           )

-- | The gzip format uses a header with a checksum and some optional meta-data
-- about the compressed file. It is intended primarily for compressing
-- individual files but is also sometimes used for network protocols such as
-- HTTP. The format is described in detail in RFC #1952
-- <http://www.ietf.org/rfc/rfc1952.txt>
--
gzipFormat :: Format
gzipFormat :: Format
gzipFormat = Format
GZip

-- | The zlib format uses a minimal header with a checksum but no other
-- meta-data. It is especially designed for use in network protocols. The
-- format is described in detail in RFC #1950
-- <http://www.ietf.org/rfc/rfc1950.txt>
--
zlibFormat :: Format
zlibFormat :: Format
zlibFormat = Format
Zlib

-- | The \'raw\' format is just the compressed data stream without any
-- additional header, meta-data or data-integrity checksum. The format is
-- described in detail in RFC #1951 <http://www.ietf.org/rfc/rfc1951.txt>
--
rawFormat :: Format
rawFormat :: Format
rawFormat = Format
Raw

-- | This is not a format as such. It enabled zlib or gzip decoding with
-- automatic header detection. This only makes sense for decompression.
--
gzipOrZlibFormat :: Format
gzipOrZlibFormat :: Format
gzipOrZlibFormat = Format
GZipOrZlib

formatSupportsDictionary :: Format -> Bool
formatSupportsDictionary :: Format -> Bool
formatSupportsDictionary Format
Zlib = Bool
True
formatSupportsDictionary Format
Raw  = Bool
True
formatSupportsDictionary Format
_    = Bool
False

-- | The compression method
--
data Method = Deflated
  deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Method -> Method -> Ordering
compare :: Method -> Method -> Ordering
$c< :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
>= :: Method -> Method -> Bool
$cmax :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
min :: Method -> Method -> Method
Ord, Int -> Method
Method -> Int
Method -> [Method]
Method -> Method
Method -> Method -> [Method]
Method -> Method -> Method -> [Method]
(Method -> Method)
-> (Method -> Method)
-> (Int -> Method)
-> (Method -> Int)
-> (Method -> [Method])
-> (Method -> Method -> [Method])
-> (Method -> Method -> [Method])
-> (Method -> Method -> Method -> [Method])
-> Enum Method
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Method -> Method
succ :: Method -> Method
$cpred :: Method -> Method
pred :: Method -> Method
$ctoEnum :: Int -> Method
toEnum :: Int -> Method
$cfromEnum :: Method -> Int
fromEnum :: Method -> Int
$cenumFrom :: Method -> [Method]
enumFrom :: Method -> [Method]
$cenumFromThen :: Method -> Method -> [Method]
enumFromThen :: Method -> Method -> [Method]
$cenumFromTo :: Method -> Method -> [Method]
enumFromTo :: Method -> Method -> [Method]
$cenumFromThenTo :: Method -> Method -> Method -> [Method]
enumFromThenTo :: Method -> Method -> Method -> [Method]
Enum, Method
Method -> Method -> Bounded Method
forall a. a -> a -> Bounded a
$cminBound :: Method
minBound :: Method
$cmaxBound :: Method
maxBound :: Method
Bounded, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show
              , (forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Method -> Rep Method x
from :: forall x. Method -> Rep Method x
$cto :: forall x. Rep Method x -> Method
to :: forall x. Rep Method x -> Method
Generic
           )

-- | The only method supported in this version of zlib.
-- Indeed it is likely to be the only method that ever will be supported.
--
deflateMethod :: Method
deflateMethod :: Method
deflateMethod = Method
Deflated

fromMethod :: Method -> CInt
fromMethod :: Method -> CInt
fromMethod Method
Deflated = CInt
8
{-# LINE 630 "Codec/Compression/Zlib/Stream.hsc" #-}


-- | The compression level parameter controls the amount of compression. This
-- is a trade-off between the amount of compression and the time required to do
-- the compression.
--
newtype CompressionLevel = CompressionLevel Int
  deriving
  ( CompressionLevel -> CompressionLevel -> Bool
(CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> Eq CompressionLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionLevel -> CompressionLevel -> Bool
== :: CompressionLevel -> CompressionLevel -> Bool
$c/= :: CompressionLevel -> CompressionLevel -> Bool
/= :: CompressionLevel -> CompressionLevel -> Bool
Eq
  , Eq CompressionLevel
Eq CompressionLevel =>
(CompressionLevel -> CompressionLevel -> Ordering)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> Ord CompressionLevel
CompressionLevel -> CompressionLevel -> Bool
CompressionLevel -> CompressionLevel -> Ordering
CompressionLevel -> CompressionLevel -> CompressionLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompressionLevel -> CompressionLevel -> Ordering
compare :: CompressionLevel -> CompressionLevel -> Ordering
$c< :: CompressionLevel -> CompressionLevel -> Bool
< :: CompressionLevel -> CompressionLevel -> Bool
$c<= :: CompressionLevel -> CompressionLevel -> Bool
<= :: CompressionLevel -> CompressionLevel -> Bool
$c> :: CompressionLevel -> CompressionLevel -> Bool
> :: CompressionLevel -> CompressionLevel -> Bool
$c>= :: CompressionLevel -> CompressionLevel -> Bool
>= :: CompressionLevel -> CompressionLevel -> Bool
$cmax :: CompressionLevel -> CompressionLevel -> CompressionLevel
max :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmin :: CompressionLevel -> CompressionLevel -> CompressionLevel
min :: CompressionLevel -> CompressionLevel -> CompressionLevel
Ord -- ^ @since 0.7.0.0
  , Int -> CompressionLevel -> ShowS
[CompressionLevel] -> ShowS
CompressionLevel -> String
(Int -> CompressionLevel -> ShowS)
-> (CompressionLevel -> String)
-> ([CompressionLevel] -> ShowS)
-> Show CompressionLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionLevel -> ShowS
showsPrec :: Int -> CompressionLevel -> ShowS
$cshow :: CompressionLevel -> String
show :: CompressionLevel -> String
$cshowList :: [CompressionLevel] -> ShowS
showList :: [CompressionLevel] -> ShowS
Show
  , (forall x. CompressionLevel -> Rep CompressionLevel x)
-> (forall x. Rep CompressionLevel x -> CompressionLevel)
-> Generic CompressionLevel
forall x. Rep CompressionLevel x -> CompressionLevel
forall x. CompressionLevel -> Rep CompressionLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompressionLevel -> Rep CompressionLevel x
from :: forall x. CompressionLevel -> Rep CompressionLevel x
$cto :: forall x. Rep CompressionLevel x -> CompressionLevel
to :: forall x. Rep CompressionLevel x -> CompressionLevel
Generic
  )

-- | The default t'CompressionLevel'.
defaultCompression :: CompressionLevel
defaultCompression :: CompressionLevel
defaultCompression = Int -> CompressionLevel
CompressionLevel Int
6

-- Ideally we should use #{const Z_DEFAULT_COMPRESSION} = -1, whose meaning
-- depends on zlib version and, strictly speaking, is not guaranteed to be 6.
-- It would however interact badly with Eq / Ord instances.

-- | No compression, just a block copy.
noCompression :: CompressionLevel
noCompression :: CompressionLevel
noCompression = Int -> CompressionLevel
CompressionLevel Int
0
{-# LINE 655 "Codec/Compression/Zlib/Stream.hsc" #-}

-- | The fastest compression method (less compression).
bestSpeed :: CompressionLevel
bestSpeed :: CompressionLevel
bestSpeed = Int -> CompressionLevel
CompressionLevel Int
1
{-# LINE 659 "Codec/Compression/Zlib/Stream.hsc" #-}

-- | The slowest compression method (best compression).
bestCompression :: CompressionLevel
bestCompression :: CompressionLevel
bestCompression = Int -> CompressionLevel
CompressionLevel Int
9
{-# LINE 663 "Codec/Compression/Zlib/Stream.hsc" #-}

-- | A specific compression level in the range @0..9@.
-- Throws an error for arguments outside of this range.
--
-- * 0 stands for 'noCompression',
-- * 1 stands for 'bestSpeed',
-- * 6 stands for 'defaultCompression',
-- * 9 stands for 'bestCompression'.
--
compressionLevel :: Int -> CompressionLevel
compressionLevel :: Int -> CompressionLevel
compressionLevel Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CompressionLevel
CompressionLevel Int
n
  | Bool
otherwise         = String -> CompressionLevel
forall a. HasCallStack => String -> a
error String
"CompressionLevel must be in the range 0..9"

fromCompressionLevel :: CompressionLevel -> CInt
fromCompressionLevel :: CompressionLevel -> CInt
fromCompressionLevel (CompressionLevel Int
n)
           | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CInt
int2cint Int
n
           | Bool
otherwise        = String -> CInt
forall a. HasCallStack => String -> a
error String
"CompressLevel must be in the range 0..9"


-- | This specifies the size of the compression window. Larger values of this
-- parameter result in better compression at the expense of higher memory
-- usage.
--
-- The compression window size is the value of the the window bits raised to
-- the power 2. The window bits must be in the range @9..15@ which corresponds
-- to compression window sizes of 512b to 32Kb. The default is 15 which is also
-- the maximum size.
--
-- The total amount of memory used depends on the window bits and the
-- t'MemoryLevel'. See the t'MemoryLevel' for the details.
--
newtype WindowBits = WindowBits Int
  deriving
  ( WindowBits -> WindowBits -> Bool
(WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> Bool) -> Eq WindowBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowBits -> WindowBits -> Bool
== :: WindowBits -> WindowBits -> Bool
$c/= :: WindowBits -> WindowBits -> Bool
/= :: WindowBits -> WindowBits -> Bool
Eq
  , Eq WindowBits
Eq WindowBits =>
(WindowBits -> WindowBits -> Ordering)
-> (WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> WindowBits)
-> (WindowBits -> WindowBits -> WindowBits)
-> Ord WindowBits
WindowBits -> WindowBits -> Bool
WindowBits -> WindowBits -> Ordering
WindowBits -> WindowBits -> WindowBits
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WindowBits -> WindowBits -> Ordering
compare :: WindowBits -> WindowBits -> Ordering
$c< :: WindowBits -> WindowBits -> Bool
< :: WindowBits -> WindowBits -> Bool
$c<= :: WindowBits -> WindowBits -> Bool
<= :: WindowBits -> WindowBits -> Bool
$c> :: WindowBits -> WindowBits -> Bool
> :: WindowBits -> WindowBits -> Bool
$c>= :: WindowBits -> WindowBits -> Bool
>= :: WindowBits -> WindowBits -> Bool
$cmax :: WindowBits -> WindowBits -> WindowBits
max :: WindowBits -> WindowBits -> WindowBits
$cmin :: WindowBits -> WindowBits -> WindowBits
min :: WindowBits -> WindowBits -> WindowBits
Ord
  , Int -> WindowBits -> ShowS
[WindowBits] -> ShowS
WindowBits -> String
(Int -> WindowBits -> ShowS)
-> (WindowBits -> String)
-> ([WindowBits] -> ShowS)
-> Show WindowBits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowBits -> ShowS
showsPrec :: Int -> WindowBits -> ShowS
$cshow :: WindowBits -> String
show :: WindowBits -> String
$cshowList :: [WindowBits] -> ShowS
showList :: [WindowBits] -> ShowS
Show
  , (forall x. WindowBits -> Rep WindowBits x)
-> (forall x. Rep WindowBits x -> WindowBits) -> Generic WindowBits
forall x. Rep WindowBits x -> WindowBits
forall x. WindowBits -> Rep WindowBits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WindowBits -> Rep WindowBits x
from :: forall x. WindowBits -> Rep WindowBits x
$cto :: forall x. Rep WindowBits x -> WindowBits
to :: forall x. Rep WindowBits x -> WindowBits
Generic
  )

-- zlib manual (https://www.zlib.net/manual.html#Advanced) says that WindowBits
-- could be in the range 8..15, but for some reason we require 9..15.
-- Could it be that older versions of zlib had a tighter limit?..

-- | The default t'WindowBits'. Equivalent to @'windowBits' 15@.
-- which is also the maximum size.
--
defaultWindowBits :: WindowBits
defaultWindowBits :: WindowBits
defaultWindowBits = Int -> WindowBits
WindowBits Int
15

-- | A specific compression window size, specified in bits in the range @9..15@.
-- Throws an error for arguments outside of this range.
--
windowBits :: Int -> WindowBits
windowBits :: Int -> WindowBits
windowBits Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
15 = Int -> WindowBits
WindowBits Int
n
  | Bool
otherwise         = String -> WindowBits
forall a. HasCallStack => String -> a
error String
"WindowBits must be in the range 9..15"

fromWindowBits :: Format -> WindowBits -> CInt
fromWindowBits :: Format -> WindowBits -> CInt
fromWindowBits Format
format WindowBits
bits = (Format -> CInt -> CInt
forall {a}. Num a => Format -> a -> a
formatModifier Format
format) (WindowBits -> CInt
checkWindowBits WindowBits
bits)
  where checkWindowBits :: WindowBits -> CInt
checkWindowBits (WindowBits Int
n)
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
9 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
15 = Int -> CInt
int2cint Int
n
          | Bool
otherwise         = String -> CInt
forall a. HasCallStack => String -> a
error String
"WindowBits must be in the range 9..15"
        formatModifier :: Format -> a -> a
formatModifier Format
Zlib       = a -> a
forall a. a -> a
id
        formatModifier Format
GZip       = (a -> a -> a
forall a. Num a => a -> a -> a
+a
16)
        formatModifier Format
GZipOrZlib = (a -> a -> a
forall a. Num a => a -> a -> a
+a
32)
        formatModifier Format
Raw        = a -> a
forall a. Num a => a -> a
negate


-- | The t'MemoryLevel' parameter specifies how much memory should be allocated
-- for the internal compression state. It is a trade-off between memory usage,
-- compression ratio and compression speed. Using more memory allows faster
-- compression and a better compression ratio.
--
-- The total amount of memory used for compression depends on the t'WindowBits'
-- and the t'MemoryLevel'. For decompression it depends only on the
-- t'WindowBits'. The totals are given by the functions:
--
-- > compressTotal windowBits memLevel = 4 * 2^windowBits + 512 * 2^memLevel
-- > decompressTotal windowBits = 2^windowBits
--
-- For example, for compression with the default @windowBits = 15@ and
-- @memLevel = 8@ uses @256Kb@. So for example a network server with 100
-- concurrent compressed streams would use @25Mb@. The memory per stream can be
-- halved (at the cost of somewhat degraded and slower compression) by
-- reducing the @windowBits@ and @memLevel@ by one.
--
-- Decompression takes less memory, the default @windowBits = 15@ corresponds
-- to just @32Kb@.
--
newtype MemoryLevel = MemoryLevel Int
  deriving
  ( MemoryLevel -> MemoryLevel -> Bool
(MemoryLevel -> MemoryLevel -> Bool)
-> (MemoryLevel -> MemoryLevel -> Bool) -> Eq MemoryLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryLevel -> MemoryLevel -> Bool
== :: MemoryLevel -> MemoryLevel -> Bool
$c/= :: MemoryLevel -> MemoryLevel -> Bool
/= :: MemoryLevel -> MemoryLevel -> Bool
Eq
  , Eq MemoryLevel
Eq MemoryLevel =>
(MemoryLevel -> MemoryLevel -> Ordering)
-> (MemoryLevel -> MemoryLevel -> Bool)
-> (MemoryLevel -> MemoryLevel -> Bool)
-> (MemoryLevel -> MemoryLevel -> Bool)
-> (MemoryLevel -> MemoryLevel -> Bool)
-> (MemoryLevel -> MemoryLevel -> MemoryLevel)
-> (MemoryLevel -> MemoryLevel -> MemoryLevel)
-> Ord MemoryLevel
MemoryLevel -> MemoryLevel -> Bool
MemoryLevel -> MemoryLevel -> Ordering
MemoryLevel -> MemoryLevel -> MemoryLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MemoryLevel -> MemoryLevel -> Ordering
compare :: MemoryLevel -> MemoryLevel -> Ordering
$c< :: MemoryLevel -> MemoryLevel -> Bool
< :: MemoryLevel -> MemoryLevel -> Bool
$c<= :: MemoryLevel -> MemoryLevel -> Bool
<= :: MemoryLevel -> MemoryLevel -> Bool
$c> :: MemoryLevel -> MemoryLevel -> Bool
> :: MemoryLevel -> MemoryLevel -> Bool
$c>= :: MemoryLevel -> MemoryLevel -> Bool
>= :: MemoryLevel -> MemoryLevel -> Bool
$cmax :: MemoryLevel -> MemoryLevel -> MemoryLevel
max :: MemoryLevel -> MemoryLevel -> MemoryLevel
$cmin :: MemoryLevel -> MemoryLevel -> MemoryLevel
min :: MemoryLevel -> MemoryLevel -> MemoryLevel
Ord -- ^ @since 0.7.0.0
  , Int -> MemoryLevel -> ShowS
[MemoryLevel] -> ShowS
MemoryLevel -> String
(Int -> MemoryLevel -> ShowS)
-> (MemoryLevel -> String)
-> ([MemoryLevel] -> ShowS)
-> Show MemoryLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryLevel -> ShowS
showsPrec :: Int -> MemoryLevel -> ShowS
$cshow :: MemoryLevel -> String
show :: MemoryLevel -> String
$cshowList :: [MemoryLevel] -> ShowS
showList :: [MemoryLevel] -> ShowS
Show
  , (forall x. MemoryLevel -> Rep MemoryLevel x)
-> (forall x. Rep MemoryLevel x -> MemoryLevel)
-> Generic MemoryLevel
forall x. Rep MemoryLevel x -> MemoryLevel
forall x. MemoryLevel -> Rep MemoryLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MemoryLevel -> Rep MemoryLevel x
from :: forall x. MemoryLevel -> Rep MemoryLevel x
$cto :: forall x. Rep MemoryLevel x -> MemoryLevel
to :: forall x. Rep MemoryLevel x -> MemoryLevel
Generic
  )

-- | The default t'MemoryLevel'. Equivalent to @'memoryLevel' 8@.
--
defaultMemoryLevel :: MemoryLevel
defaultMemoryLevel :: MemoryLevel
defaultMemoryLevel = Int -> MemoryLevel
MemoryLevel Int
8

-- | Use minimum memory. This is slow and reduces the compression ratio.
-- Equivalent to @'memoryLevel' 1@.
--
minMemoryLevel :: MemoryLevel
minMemoryLevel :: MemoryLevel
minMemoryLevel = Int -> MemoryLevel
MemoryLevel Int
1

-- | Use maximum memory for optimal compression speed.
-- Equivalent to @'memoryLevel' 9@.
--
maxMemoryLevel :: MemoryLevel
maxMemoryLevel :: MemoryLevel
maxMemoryLevel = Int -> MemoryLevel
MemoryLevel Int
9

-- | A specific memory level in the range @1..9@.
-- Throws an error for arguments outside of this range.
--
memoryLevel :: Int -> MemoryLevel
memoryLevel :: Int -> MemoryLevel
memoryLevel Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> MemoryLevel
MemoryLevel Int
n
  | Bool
otherwise        = String -> MemoryLevel
forall a. HasCallStack => String -> a
error String
"MemoryLevel must be in the range 1..9"

fromMemoryLevel :: MemoryLevel -> CInt
fromMemoryLevel :: MemoryLevel -> CInt
fromMemoryLevel (MemoryLevel Int
n)
         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CInt
int2cint Int
n
         | Bool
otherwise        = String -> CInt
forall a. HasCallStack => String -> a
error String
"MemoryLevel must be in the range 1..9"


-- | The strategy parameter is used to tune the compression algorithm.
--
-- The strategy parameter only affects the compression ratio but not the
-- correctness of the compressed output even if it is not set appropriately.
--
data CompressionStrategy =
    DefaultStrategy
  | Filtered
  | HuffmanOnly
  | RLE
  -- ^ @since 0.7.0.0
  | Fixed
  -- ^ @since 0.7.0.0
  deriving (CompressionStrategy -> CompressionStrategy -> Bool
(CompressionStrategy -> CompressionStrategy -> Bool)
-> (CompressionStrategy -> CompressionStrategy -> Bool)
-> Eq CompressionStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionStrategy -> CompressionStrategy -> Bool
== :: CompressionStrategy -> CompressionStrategy -> Bool
$c/= :: CompressionStrategy -> CompressionStrategy -> Bool
/= :: CompressionStrategy -> CompressionStrategy -> Bool
Eq, Eq CompressionStrategy
Eq CompressionStrategy =>
(CompressionStrategy -> CompressionStrategy -> Ordering)
-> (CompressionStrategy -> CompressionStrategy -> Bool)
-> (CompressionStrategy -> CompressionStrategy -> Bool)
-> (CompressionStrategy -> CompressionStrategy -> Bool)
-> (CompressionStrategy -> CompressionStrategy -> Bool)
-> (CompressionStrategy
    -> CompressionStrategy -> CompressionStrategy)
-> (CompressionStrategy
    -> CompressionStrategy -> CompressionStrategy)
-> Ord CompressionStrategy
CompressionStrategy -> CompressionStrategy -> Bool
CompressionStrategy -> CompressionStrategy -> Ordering
CompressionStrategy -> CompressionStrategy -> CompressionStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompressionStrategy -> CompressionStrategy -> Ordering
compare :: CompressionStrategy -> CompressionStrategy -> Ordering
$c< :: CompressionStrategy -> CompressionStrategy -> Bool
< :: CompressionStrategy -> CompressionStrategy -> Bool
$c<= :: CompressionStrategy -> CompressionStrategy -> Bool
<= :: CompressionStrategy -> CompressionStrategy -> Bool
$c> :: CompressionStrategy -> CompressionStrategy -> Bool
> :: CompressionStrategy -> CompressionStrategy -> Bool
$c>= :: CompressionStrategy -> CompressionStrategy -> Bool
>= :: CompressionStrategy -> CompressionStrategy -> Bool
$cmax :: CompressionStrategy -> CompressionStrategy -> CompressionStrategy
max :: CompressionStrategy -> CompressionStrategy -> CompressionStrategy
$cmin :: CompressionStrategy -> CompressionStrategy -> CompressionStrategy
min :: CompressionStrategy -> CompressionStrategy -> CompressionStrategy
Ord, Int -> CompressionStrategy
CompressionStrategy -> Int
CompressionStrategy -> [CompressionStrategy]
CompressionStrategy -> CompressionStrategy
CompressionStrategy -> CompressionStrategy -> [CompressionStrategy]
CompressionStrategy
-> CompressionStrategy
-> CompressionStrategy
-> [CompressionStrategy]
(CompressionStrategy -> CompressionStrategy)
-> (CompressionStrategy -> CompressionStrategy)
-> (Int -> CompressionStrategy)
-> (CompressionStrategy -> Int)
-> (CompressionStrategy -> [CompressionStrategy])
-> (CompressionStrategy
    -> CompressionStrategy -> [CompressionStrategy])
-> (CompressionStrategy
    -> CompressionStrategy -> [CompressionStrategy])
-> (CompressionStrategy
    -> CompressionStrategy
    -> CompressionStrategy
    -> [CompressionStrategy])
-> Enum CompressionStrategy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CompressionStrategy -> CompressionStrategy
succ :: CompressionStrategy -> CompressionStrategy
$cpred :: CompressionStrategy -> CompressionStrategy
pred :: CompressionStrategy -> CompressionStrategy
$ctoEnum :: Int -> CompressionStrategy
toEnum :: Int -> CompressionStrategy
$cfromEnum :: CompressionStrategy -> Int
fromEnum :: CompressionStrategy -> Int
$cenumFrom :: CompressionStrategy -> [CompressionStrategy]
enumFrom :: CompressionStrategy -> [CompressionStrategy]
$cenumFromThen :: CompressionStrategy -> CompressionStrategy -> [CompressionStrategy]
enumFromThen :: CompressionStrategy -> CompressionStrategy -> [CompressionStrategy]
$cenumFromTo :: CompressionStrategy -> CompressionStrategy -> [CompressionStrategy]
enumFromTo :: CompressionStrategy -> CompressionStrategy -> [CompressionStrategy]
$cenumFromThenTo :: CompressionStrategy
-> CompressionStrategy
-> CompressionStrategy
-> [CompressionStrategy]
enumFromThenTo :: CompressionStrategy
-> CompressionStrategy
-> CompressionStrategy
-> [CompressionStrategy]
Enum, CompressionStrategy
CompressionStrategy
-> CompressionStrategy -> Bounded CompressionStrategy
forall a. a -> a -> Bounded a
$cminBound :: CompressionStrategy
minBound :: CompressionStrategy
$cmaxBound :: CompressionStrategy
maxBound :: CompressionStrategy
Bounded, Int -> CompressionStrategy -> ShowS
[CompressionStrategy] -> ShowS
CompressionStrategy -> String
(Int -> CompressionStrategy -> ShowS)
-> (CompressionStrategy -> String)
-> ([CompressionStrategy] -> ShowS)
-> Show CompressionStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionStrategy -> ShowS
showsPrec :: Int -> CompressionStrategy -> ShowS
$cshow :: CompressionStrategy -> String
show :: CompressionStrategy -> String
$cshowList :: [CompressionStrategy] -> ShowS
showList :: [CompressionStrategy] -> ShowS
Show
              , (forall x. CompressionStrategy -> Rep CompressionStrategy x)
-> (forall x. Rep CompressionStrategy x -> CompressionStrategy)
-> Generic CompressionStrategy
forall x. Rep CompressionStrategy x -> CompressionStrategy
forall x. CompressionStrategy -> Rep CompressionStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompressionStrategy -> Rep CompressionStrategy x
from :: forall x. CompressionStrategy -> Rep CompressionStrategy x
$cto :: forall x. Rep CompressionStrategy x -> CompressionStrategy
to :: forall x. Rep CompressionStrategy x -> CompressionStrategy
Generic
           )

-- | Use this default compression strategy for normal data.
--
defaultStrategy :: CompressionStrategy
defaultStrategy :: CompressionStrategy
defaultStrategy = CompressionStrategy
DefaultStrategy

-- | Use the filtered compression strategy for data produced by a filter (or
-- predictor). Filtered data consists mostly of small values with a somewhat
-- random distribution. In this case, the compression algorithm is tuned to
-- compress them better. The effect of this strategy is to force more Huffman
-- coding and less string matching; it is somewhat intermediate between
-- 'defaultStrategy' and 'huffmanOnlyStrategy'.
--
filteredStrategy :: CompressionStrategy
filteredStrategy :: CompressionStrategy
filteredStrategy = CompressionStrategy
Filtered

-- | Use the Huffman-only compression strategy to force Huffman encoding only
-- (no string match).
--
huffmanOnlyStrategy :: CompressionStrategy
huffmanOnlyStrategy :: CompressionStrategy
huffmanOnlyStrategy = CompressionStrategy
HuffmanOnly

-- | Use 'rleStrategy' to limit match distances to one (run-length
-- encoding). 'rleStrategy' is designed to be almost as fast as
-- 'huffmanOnlyStrategy', but give better compression for PNG
-- image data.
--
-- @since 0.7.0.0
rleStrategy :: CompressionStrategy
rleStrategy :: CompressionStrategy
rleStrategy = CompressionStrategy
RLE

-- | 'fixedStrategy' prevents the use of dynamic Huffman codes,
-- allowing for a simpler decoder for special applications.
--
-- @since 0.7.0.0
fixedStrategy :: CompressionStrategy
fixedStrategy :: CompressionStrategy
fixedStrategy = CompressionStrategy
Fixed

fromCompressionStrategy :: CompressionStrategy -> CInt
fromCompressionStrategy :: CompressionStrategy -> CInt
fromCompressionStrategy CompressionStrategy
DefaultStrategy = CInt
0
{-# LINE 848 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy Filtered        = 1
{-# LINE 849 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy HuffmanOnly     = 2
{-# LINE 850 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy RLE             = 3
{-# LINE 851 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy Fixed           = 4
{-# LINE 852 "Codec/Compression/Zlib/Stream.hsc" #-}

withStreamPtr :: (Ptr StreamState -> IO a) -> Stream a
withStreamPtr :: forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr Ptr StreamState -> IO a
f = do
  ForeignPtr StreamState
stream <- Stream (ForeignPtr StreamState)
getStreamState
  IO a -> Stream a
forall a. IO a -> Stream a
unsafeLiftIO (ForeignPtr StreamState -> (Ptr StreamState -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr StreamState
stream Ptr StreamState -> IO a
f)

withStreamState :: (StreamState -> IO a) -> Stream a
withStreamState :: forall a. (StreamState -> IO a) -> Stream a
withStreamState StreamState -> IO a
f = do
  ForeignPtr StreamState
stream <- Stream (ForeignPtr StreamState)
getStreamState
  IO a -> Stream a
forall a. IO a -> Stream a
unsafeLiftIO (ForeignPtr StreamState -> (Ptr StreamState -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr StreamState
stream (StreamState -> IO a
f (StreamState -> IO a)
-> (Ptr StreamState -> StreamState) -> Ptr StreamState -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr StreamState -> StreamState
StreamState))

setInAvail :: CUInt -> Stream ()
setInAvail :: CUInt -> Stream ()
setInAvail CUInt
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((Ptr StreamState -> IO ()) -> Stream ())
-> (Ptr StreamState -> IO ()) -> Stream ()
forall a b. (a -> b) -> a -> b
$ \Ptr StreamState
ptr ->
  (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
8) Ptr StreamState
ptr CUInt
val
{-# LINE 866 "Codec/Compression/Zlib/Stream.hsc" #-}

getInAvail :: Stream Int
getInAvail :: Stream Int
getInAvail = (CUInt -> Int) -> Stream CUInt -> Stream Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
cuint2int (Stream CUInt -> Stream Int) -> Stream CUInt -> Stream Int
forall a b. (a -> b) -> a -> b
$
  (Ptr StreamState -> IO CUInt) -> Stream CUInt
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
8))
{-# LINE 870 "Codec/Compression/Zlib/Stream.hsc" #-}

setInNext :: Ptr Word8 -> Stream ()
setInNext :: Ptr Word8 -> Stream ()
setInNext Ptr Word8
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr (\Ptr StreamState
ptr -> (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
0) Ptr StreamState
ptr Ptr Word8
val)
{-# LINE 873 "Codec/Compression/Zlib/Stream.hsc" #-}

getInNext :: Stream (Ptr Word8)
getInNext :: Stream (Ptr Word8)
getInNext = (Ptr StreamState -> IO (Ptr Word8)) -> Stream (Ptr Word8)
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
0))
{-# LINE 876 "Codec/Compression/Zlib/Stream.hsc" #-}

setOutFree :: CUInt -> Stream ()
setOutFree :: CUInt -> Stream ()
setOutFree CUInt
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((Ptr StreamState -> IO ()) -> Stream ())
-> (Ptr StreamState -> IO ()) -> Stream ()
forall a b. (a -> b) -> a -> b
$ \Ptr StreamState
ptr ->
  (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
32) Ptr StreamState
ptr CUInt
val
{-# LINE 880 "Codec/Compression/Zlib/Stream.hsc" #-}

getOutFree :: Stream Int
getOutFree :: Stream Int
getOutFree = (CUInt -> Int) -> Stream CUInt -> Stream Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
cuint2int (Stream CUInt -> Stream Int) -> Stream CUInt -> Stream Int
forall a b. (a -> b) -> a -> b
$
  (Ptr StreamState -> IO CUInt) -> Stream CUInt
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
32))
{-# LINE 884 "Codec/Compression/Zlib/Stream.hsc" #-}

setOutNext  :: Ptr Word8 -> Stream ()
setOutNext :: Ptr Word8 -> Stream ()
setOutNext Ptr Word8
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr (\Ptr StreamState
ptr -> (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
24) Ptr StreamState
ptr Ptr Word8
val)
{-# LINE 887 "Codec/Compression/Zlib/Stream.hsc" #-}


{-# LINE 892 "Codec/Compression/Zlib/Stream.hsc" #-}

inflateInit :: Format -> WindowBits -> Stream ()
inflateInit :: Format -> WindowBits -> Stream ()
inflateInit Format
format WindowBits
bits = do
  Format -> Stream ()
checkFormatSupported Format
format
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
    StreamState -> CInt -> IO CInt
c_inflateInit2 StreamState
zstream (Format -> WindowBits -> CInt
fromWindowBits Format
format WindowBits
bits)
  CInt -> Stream ()
failIfError CInt
err
  Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr StreamState -> ForeignPtr StreamState -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr StreamState
c_inflateEnd

deflateInit :: Format
            -> CompressionLevel
            -> Method
            -> WindowBits
            -> MemoryLevel
            -> CompressionStrategy
            -> Stream ()
deflateInit :: Format
-> CompressionLevel
-> Method
-> WindowBits
-> MemoryLevel
-> CompressionStrategy
-> Stream ()
deflateInit Format
format CompressionLevel
compLevel Method
method WindowBits
bits MemoryLevel
memLevel CompressionStrategy
strategy = do
  Format -> Stream ()
checkFormatSupported Format
format
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
    StreamState -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
c_deflateInit2 StreamState
zstream
                  (CompressionLevel -> CInt
fromCompressionLevel CompressionLevel
compLevel)
                  (Method -> CInt
fromMethod Method
method)
                  (Format -> WindowBits -> CInt
fromWindowBits Format
format WindowBits
bits)
                  (MemoryLevel -> CInt
fromMemoryLevel MemoryLevel
memLevel)
                  (CompressionStrategy -> CInt
fromCompressionStrategy CompressionStrategy
strategy)
  CInt -> Stream ()
failIfError CInt
err
  Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr StreamState -> ForeignPtr StreamState -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr StreamState
c_deflateEnd

inflate_ :: Flush -> Stream Status
inflate_ :: Flush -> Stream Status
inflate_ Flush
flush = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
    StreamState -> CInt -> IO CInt
c_inflate StreamState
zstream (Flush -> CInt
fromFlush Flush
flush)
  CInt -> Stream Status
toStatus CInt
err

deflate_ :: Flush -> Stream Status
deflate_ :: Flush -> Stream Status
deflate_ Flush
flush = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
zstream ->
    StreamState -> CInt -> IO CInt
c_deflate StreamState
zstream (Flush -> CInt
fromFlush Flush
flush)
  CInt -> Stream Status
toStatus CInt
err

-- | This never needs to be used as the stream's resources will be released
-- automatically when no longer needed, however this can be used to release
-- them early. Only use this when you can guarantee that the stream will no
-- longer be needed, for example if an error occurs or if the stream ends.
--
finalise :: Stream ()
--TODO: finalizeForeignPtr is ghc-only
finalise :: Stream ()
finalise = Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr StreamState -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr

checkFormatSupported :: Format -> Stream ()
checkFormatSupported :: Format -> Stream ()
checkFormatSupported Format
format = do
  String
version <- IO String -> Stream String
forall a. IO a -> Stream a
unsafeLiftIO ((CString -> IO String) -> ConstPtr CChar -> IO String
forall a b. Coercible a b => a -> b
coerce CString -> IO String
peekCAString (ConstPtr CChar -> IO String) -> IO (ConstPtr CChar) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (ConstPtr CChar)
c_zlibVersion)
  case String
version of
    (Char
'1':Char
'.':Char
'1':Char
'.':String
_)
       | Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
GZip
      Bool -> Bool -> Bool
|| Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
GZipOrZlib
      -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Stream ()) -> String -> Stream ()
forall a b. (a -> b) -> a -> b
$ String
"version 1.1.x of the zlib C library does not support the"
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 'gzip' format via the in-memory api, only the 'raw' and "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" 'zlib' formats."
    String
_ -> () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | This one should not fail on 64-bit arch.
cuint2int :: CUInt -> Int
cuint2int :: CUInt -> Int
cuint2int CUInt
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"cuint2int: cannot cast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CUInt -> String
forall a. Show a => a -> String
show CUInt
n) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized CUInt
n

-- | This one could and will fail if chunks of ByteString are longer than 4G.
int2cuint :: Int -> CUInt
int2cuint :: Int -> CUInt
int2cuint Int
n = CUInt -> Maybe CUInt -> CUInt
forall a. a -> Maybe a -> a
fromMaybe (String -> CUInt
forall a. HasCallStack => String -> a
error (String -> CUInt) -> String -> CUInt
forall a b. (a -> b) -> a -> b
$ String
"int2cuint: cannot cast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (Maybe CUInt -> CUInt) -> Maybe CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$ Int -> Maybe CUInt
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Int
n

-- | This one could fail in theory, but is used only on arguments 0..9 or 0..15.
int2cint :: Int -> CInt
int2cint :: Int -> CInt
int2cint Int
n = CInt -> Maybe CInt -> CInt
forall a. a -> Maybe a -> a
fromMaybe (String -> CInt
forall a. HasCallStack => String -> a
error (String -> CInt) -> String -> CInt
forall a b. (a -> b) -> a -> b
$ String
"int2cint: cannot cast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (Maybe CInt -> CInt) -> Maybe CInt -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Maybe CInt
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Int
n

----------------------
-- The foreign imports

newtype StreamState = StreamState (Ptr StreamState)

#ifdef NON_BLOCKING_FFI
#define SAFTY safe
#else
#define SAFTY unsafe
#endif

foreign import capi unsafe "zlib.h inflateInit2"
  c_inflateInit2 :: StreamState -> CInt -> IO CInt
 
foreign import capi unsafe "zlib.h deflateInit2"
  c_deflateInit2 :: StreamState
                 -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt

foreign import capi SAFTY "zlib.h inflate"
  c_inflate :: StreamState -> CInt -> IO CInt

foreign import capi unsafe "hs-zlib.h &_hs_zlib_inflateEnd"
  c_inflateEnd :: FinalizerPtr StreamState

foreign import capi unsafe "zlib.h inflateReset"
  c_inflateReset :: StreamState -> IO CInt

foreign import capi unsafe "zlib.h deflateSetDictionary"
  c_deflateSetDictionary :: StreamState
                         -> Ptr CUChar
                         -> CUInt
                         -> IO CInt

foreign import capi unsafe "zlib.h inflateSetDictionary"
  c_inflateSetDictionary :: StreamState
                         -> Ptr CUChar
                         -> CUInt
                         -> IO CInt

foreign import capi SAFTY "zlib.h deflate"
  c_deflate :: StreamState -> CInt -> IO CInt

foreign import capi unsafe "hs-zlib.h &_hs_zlib_deflateEnd"
  c_deflateEnd :: FinalizerPtr StreamState


{-# LINE 1011 "Codec/Compression/Zlib/Stream.hsc" #-}
foreign import capi unsafe "zlib.h zlibVersion"
  c_zlibVersion :: IO (ConstPtr CChar)

{-# LINE 1017 "Codec/Compression/Zlib/Stream.hsc" #-}

foreign import capi unsafe "zlib.h adler32"
  c_adler32 :: CULong
            -> Ptr CUChar
            -> CUInt
            -> IO CULong