{-# LINE 1 "src/Bio/Iteratee/ZLib.hsc" #-}
-- Stolen from iteratee-compress module, which doesn't work due to
-- dependency problems.  Modified for proper early-out behaviour.
module Bio.Iteratee.ZLib
  (
    -- * Enumeratees
    enumInflate,
    enumInflateAny,
    enumDeflate,
    -- * Exceptions
    ZLibParamsException(..),
    ZLibException(..),
    -- * Parameters
    CompressParams(..),
    defaultCompressParams,
    DecompressParams(..),
    defaultDecompressParams,
    Format(..),
    CompressionLevel(..),
    Method(..),
    WindowBits(..),
    MemoryLevel(..),
    CompressionStrategy(..),
    enumSyncFlush,
    enumFullFlush,
    enumBlockFlush,
  )
where


import Bio.Iteratee
import Control.Applicative
import Control.Exception
import Control.Monad ( liftM, liftM2 )
import Data.ByteString as BS
import Data.ByteString.Internal
import Data.Foldable
import Data.Typeable
import Foreign
import Foreign.C
import Prelude

{-# LINE 46 "src/Bio/Iteratee/ZLib.hsc" #-}

-- | Denotes error is user-supplied parameter
data ZLibParamsException
    = IncorrectCompressionLevel !Int
    -- ^ Incorrect compression level was chosen
    | IncorrectWindowBits !Int
    -- ^ Incorrect number of window bits was chosen
    | IncorrectMemoryLevel !Int
    -- ^ Incorrect memory level was chosen
    deriving (Eq,Typeable)

-- | Denotes error in compression and decompression
data ZLibException
    = NeedDictionary
    -- ^ Decompression requires user-supplied dictionary (not supported)
    | BufferError
    -- ^ Buffer error - denotes a library error
--    | File Error
    | StreamError
    -- ^ State of steam inconsistent
    | DataError
    -- ^ Input data corrupted
    | MemoryError
    -- ^ Not enough memory
    | VersionError
    -- ^ Version error
    | Unexpected !CInt
    -- ^ Unexpected or unknown error - please report as bug
    | IncorrectState
    -- ^ Incorrect state - denotes error in library
    deriving (Eq,Typeable)

-- | Denotes the flush that can be sent to stream
data ZlibFlush
    = SyncFlush
    -- ^ All pending output is flushed and all input that is available is sent
    -- to inner Iteratee.
    | FullFlush
    -- ^ Flush all pending output and reset the compression state. It allows to
    -- restart from this point if compression was damaged but it can seriously
    -- affect the compression rate.
    --
    -- It may be only used during compression.
    | Block
    -- ^ If the iteratee is compressing it requests to stop when next block is
    -- emmited. On the beginning it skips only header if and only if it exists.
    deriving (Eq,Typeable)

instance Show ZlibFlush where
    show SyncFlush = "zlib: flush requested"
    show FullFlush = "zlib: full flush requested"
    show Block = "zlib: block flush requested"

instance Exception ZlibFlush

fromFlush :: ZlibFlush -> CInt
fromFlush SyncFlush = 2
{-# LINE 103 "src/Bio/Iteratee/ZLib.hsc" #-}
fromFlush FullFlush = 3
{-# LINE 104 "src/Bio/Iteratee/ZLib.hsc" #-}
fromFlush Block = 5
{-# LINE 105 "src/Bio/Iteratee/ZLib.hsc" #-}

instance Show ZLibParamsException where
    show (IncorrectCompressionLevel lvl)
        = "zlib: incorrect compression level " ++ show lvl
    show (IncorrectWindowBits lvl)
        = "zlib: incorrect window bits " ++ show lvl
    show (IncorrectMemoryLevel lvl)
        = "zlib: incorrect memory level " ++ show lvl

instance Show ZLibException where
    show NeedDictionary = "zlib: needs dictionary"
    show BufferError = "zlib: no progress is possible (internal error)"
--    show FileError = "zlib: file I/O error"
    show StreamError = "zlib: stream error"
    show DataError = "zlib: data error"
    show MemoryError = "zlib: memory error"
    show VersionError = "zlib: version error"
    show (Unexpected lvl) = "zlib: unknown error " ++ show lvl
    show IncorrectState = "zlib: incorrect state"

instance Exception ZLibParamsException
instance Exception ZLibException

newtype ZStream = ZStream (ForeignPtr ZStream)
withZStream :: ZStream -> (Ptr ZStream -> IO a) -> IO a
withZStream (ZStream fptr) = withForeignPtr fptr


-- Following code is copied from Duncan Coutts zlib haskell library version
-- 0.5.2.0 ((c) 2006-2008 Duncan Coutts, published on BSD licence) and adapted

-- | Set of parameters for compression. For sane defaults use
-- 'defaultCompressParams'
data CompressParams = CompressParams {
      compressLevel :: !CompressionLevel,
      compressMethod :: !Method,
      compressWindowBits :: !WindowBits,
      compressMemoryLevel :: !MemoryLevel,
      compressStrategy :: !CompressionStrategy,
      -- | The size of output buffer. That is the size of 'Chunk's that will be
      -- emitted to inner iterator (except the last 'Chunk').
      compressBufferSize :: !Int,
      compressDictionary :: !(Maybe ByteString)
    }

defaultCompressParams :: CompressParams
defaultCompressParams
    = CompressParams DefaultCompression Deflated DefaultWindowBits
                     DefaultMemoryLevel DefaultStrategy (8*1024) Nothing

-- | Set of parameters for decompression. For sane defaults see
-- 'defaultDecompressParams'.
data DecompressParams = DecompressParams {
      -- | Window size - it have to be at least the size of
      -- 'compressWindowBits' the stream was compressed with.
      --
      -- Default in 'defaultDecompressParams' is the maximum window size -
      -- please do not touch it unless you know what you are doing.
      decompressWindowBits :: !WindowBits,
      -- | The size of output buffer. That is the size of 'Chunk's that will be
      -- emitted to inner iterator (except the last 'Chunk').
      decompressBufferSize :: !Int,
      decompressDictionary :: !(Maybe ByteString)
    }

defaultDecompressParams :: DecompressParams
defaultDecompressParams = DecompressParams DefaultWindowBits (8*1024) Nothing

-- | Specify the format for compression and decompression
data Format
    = GZip
    -- ^ The gzip format is widely used and uses a header with checksum and
    -- some optional metadata about the compress file.
    --
    -- It is intended primarily for compressing individual files but is also
    -- used for network protocols such as HTTP.
    --
    -- The format is described in RFC 1952
    -- <http://www.ietf.org/rfc/rfc1952.txt>.
    | Zlib
    -- ^ The zlib format uses a minimal header with a checksum but no other
    -- metadata. It is designed for use in network protocols.
    --
    -- The format is described in RFC 1950
    -- <http://www.ietf.org/rfc/rfc1950.txt>
    | Raw
    -- ^ The \'raw\' format is just the DEFLATE compressed data stream without
    -- and additionl headers.
    --
    -- Thr format is described in RFC 1951
    -- <http://www.ietf.org/rfc/rfc1951.txt>
    | GZipOrZlib
    -- ^ "Format" for decompressing a 'Zlib' or 'GZip' stream.
    deriving (Eq)

-- | The compression level specify the tradeoff between speed and compression.
data CompressionLevel
    = DefaultCompression
    -- ^ Default compression level set at 6.
    | NoCompression
    -- ^ No compression, just a block copy.
    | BestSpeed
    -- ^ The fastest compression method (however less compression)
    | BestCompression
    -- ^ The best compression method (however slowest)
    | CompressionLevel Int
    -- ^ Compression level set by number from 1 to 9

-- | Specify the compression method.
data Method
    = Deflated
    -- ^ \'Deflate\' is so far the only method supported.

-- | This specify the size of compression level. Larger values result in better
-- compression at the expense of highier memory usage.
--
-- The compression window size is 2 to the power of the value of the window
-- bits.
--
-- The total memory used depends on windows bits and 'MemoryLevel'.
data WindowBits
    = WindowBits Int
    -- ^ The size of window bits. It have to be between @8@ (which corresponds
    -- to 256b i.e. 32B) and @15@ (which corresponds to 32 kib i.e. 4kiB).
    | DefaultWindowBits
    -- ^ The default window size which is 4kiB

-- | The 'MemoryLevel' specifies how much memory should be allocated for the
-- internal state. It is a tradeoff between memory usage, speed and
-- compression.
-- Using more memory allows faster and better compression.
--
-- The memory used for interal state, excluding 'WindowBits', is 512 bits times
-- 2 to power of memory level.
--
-- The total amount of memory use depends on the 'WindowBits' and
-- 'MemoryLevel'.
data MemoryLevel
    = DefaultMemoryLevel
    -- ^ Default memory level set to 8.
    | MinMemoryLevel
    -- ^ Use the small amount of memory (equivalent to memory level 1) - i.e.
    -- 1024b or 256 B.
    -- It slow and reduces the compresion ratio.
    | MaxMemoryLevel
    -- ^ Maximum memory level for optimal compression speed (equivalent to
    -- memory level 9).
    -- The internal state is 256kib or 32kiB.
    | MemoryLevel Int
    -- ^ A specific level. It have to be between 1 and 9.

-- | Tunes the compress algorithm but does not affact the correctness.
data CompressionStrategy
    = DefaultStrategy
    -- ^ Default strategy
    | Filtered
    -- ^ 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 'HuffmanOnly'.
    | HuffmanOnly
    -- ^ Use the Huffman-only compression strategy to force Huffman encoding
    -- only (no string match).

fromMethod :: Method -> CInt
fromMethod Deflated = 8
{-# LINE 273 "src/Bio/Iteratee/ZLib.hsc" #-}

fromCompressionLevel :: CompressionLevel -> Either ZLibParamsException CInt
fromCompressionLevel DefaultCompression = Right $! -1
fromCompressionLevel NoCompression = Right $! 0
fromCompressionLevel BestSpeed = Right $! 1
fromCompressionLevel BestCompression = Right $! 9
fromCompressionLevel (CompressionLevel n)
    | n >= 0 && n <= 9 = Right $! fromIntegral $! n
    | otherwise = Left $! IncorrectCompressionLevel n

fromWindowBits :: Format -> WindowBits -> Either ZLibParamsException CInt
fromWindowBits format bits
    = formatModifier format <$> checkWindowBits bits
    where checkWindowBits DefaultWindowBits = Right $! 15
          checkWindowBits (WindowBits n)
              | n >= 8 && n <= 15 = Right $! fromIntegral $! n
              | otherwise = Left $! IncorrectWindowBits $! n
          formatModifier Zlib       = id
          formatModifier GZip       = (+16)
          formatModifier GZipOrZlib = (+32)
          formatModifier Raw        = negate

fromMemoryLevel :: MemoryLevel -> Either ZLibParamsException CInt
fromMemoryLevel DefaultMemoryLevel = Right $! 8
fromMemoryLevel MinMemoryLevel     = Right $! 1
fromMemoryLevel MaxMemoryLevel     = Right $! 9
fromMemoryLevel (MemoryLevel n)
         | n >= 1 && n <= 9 = Right $! fromIntegral n
         | otherwise        = Left $! IncorrectMemoryLevel $! fromIntegral n

fromCompressionStrategy :: CompressionStrategy -> CInt
fromCompressionStrategy DefaultStrategy = 0
{-# LINE 305 "src/Bio/Iteratee/ZLib.hsc" #-}
fromCompressionStrategy Filtered        = 1
{-# LINE 306 "src/Bio/Iteratee/ZLib.hsc" #-}
fromCompressionStrategy HuffmanOnly     = 2
{-# LINE 307 "src/Bio/Iteratee/ZLib.hsc" #-}

fromErrno :: CInt -> Either ZLibException Bool
fromErrno (0) = Right $! True
{-# LINE 310 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (1) = Right $! False
{-# LINE 311 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (2) = Left $! NeedDictionary
{-# LINE 312 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (-5) = Left $! BufferError
{-# LINE 313 "src/Bio/Iteratee/ZLib.hsc" #-}
--fromErrno (#{const Z_ERRNO}) = Left $! FileError
fromErrno (-2) = Left $! StreamError
{-# LINE 315 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (-3) = Left $! DataError
{-# LINE 316 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (-4) = Left $! MemoryError
{-# LINE 317 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno (-6) = Left $! VersionError
{-# LINE 318 "src/Bio/Iteratee/ZLib.hsc" #-}
fromErrno n = Left $! Unexpected n

-- Helper function
convParam :: Format
          -> CompressParams
          -> Either ZLibParamsException (CInt, CInt, CInt, CInt, CInt)
convParam f (CompressParams c m w l s _ _)
    = let c' = fromCompressionLevel c
          m' = fromMethod m
          b' = fromWindowBits f w
          l' = fromMemoryLevel l
          s' = fromCompressionStrategy s
          eit = either Left
          r = Right
      in eit (\c_ -> eit (\b_ -> eit (\l_ -> r (c_, m', b_, l_, s')) l') b') c'

-- In following code we go through 7 states. Some of the operations are
-- 'deterministic' like 'insertOut' and some of them depends on input ('fill')
-- or library call.
--
--                                                  (Finished)
--                                                     ^
--                                                     |
--                                                     |
--                                                     | finish
--                                                     |
--              insertOut                fill[1]       |
---  (Initial) -------------> (EmptyIn) -----------> (Finishing)
--         ^                    ^ | ^ |
--         |             run[2] | | | \------------------\
--         |                    | | |                    |
--         |                    | | \------------------\ |
--         |    run[1]          | |        flush[0]    | |
--         \------------------\ | | fill[0]            | | fill[3]
--                            | | |                    | |
--                            | | |                    | |
--               swapOut      | | v       flush[1]     | v
--  (FullOut) -------------> (Invalid) <----------- (Flushing)
--
-- Initial: Initial state, both buffers are empty
-- EmptyIn: Empty in buffer, out waits untill filled
-- FullOut: Out was filled and sent. In was not entirely read
-- Invalid[1]: Both buffers non-empty
-- Finishing: There is no more in data and in buffer is empty. Waits till
--    all outs was sent.
-- Finished: Operation finished
-- Flushing: Flush requested
--
-- Please note that the decompressing can finish also on flush and finish.
--
-- [1] Named for 'historical' reasons

newtype Initial = Initial ZStream
data EmptyIn = EmptyIn !ZStream !ByteString
data FullOut = FullOut !ZStream !ByteString
data Invalid = Invalid !ZStream !ByteString !ByteString
data Finishing = Finishing !ZStream !ByteString
data Flushing = Flushing !ZStream !ZlibFlush !ByteString

withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString (PS ptr off len) f
    = withForeignPtr ptr (\ptr' -> f (ptr' `plusPtr` off) len)


{-# LINE 410 "src/Bio/Iteratee/ZLib.hsc" #-}
mkByteString :: MonadIO m => Int -> m ByteString
mkByteString s = liftIO $ create s (\_ -> return ())

{-# LINE 413 "src/Bio/Iteratee/ZLib.hsc" #-}

putOutBuffer :: Int -> ZStream -> IO ByteString
putOutBuffer size zstr = do
    _out <- mkByteString size
    withByteString _out $ \ptr len -> withZStream zstr $ \zptr -> do
        (\hsc_ptr -> pokeByteOff hsc_ptr 24) zptr ptr
{-# LINE 419 "src/Bio/Iteratee/ZLib.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 32) zptr len
{-# LINE 420 "src/Bio/Iteratee/ZLib.hsc" #-}
    return _out

putInBuffer :: ZStream -> ByteString -> IO ()
putInBuffer zstr _in
    = withByteString _in $ \ptr len -> withZStream zstr $ \zptr -> do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) zptr ptr
{-# LINE 426 "src/Bio/Iteratee/ZLib.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) zptr len
{-# LINE 427 "src/Bio/Iteratee/ZLib.hsc" #-}

pullOutBuffer :: ZStream -> ByteString -> IO ByteString
pullOutBuffer zstr _out = withByteString _out $ \ptr _ -> do
    next_out <- withZStream zstr $ \zptr -> (\hsc_ptr -> peekByteOff hsc_ptr 24) zptr
{-# LINE 431 "src/Bio/Iteratee/ZLib.hsc" #-}
    return $! BS.take (next_out `minusPtr` ptr) _out

pullInBuffer :: ZStream -> ByteString -> IO ByteString
pullInBuffer zstr _in = withByteString _in $ \ptr _ -> do
    next_in <- withZStream zstr $ \zptr -> (\hsc_ptr -> peekByteOff hsc_ptr 0) zptr
{-# LINE 436 "src/Bio/Iteratee/ZLib.hsc" #-}
    return $! BS.drop (next_in `minusPtr` ptr) _in

type EnumerateeS eli elo m a = (Stream eli -> Iteratee eli m a) -> Iteratee elo m (Iteratee eli m a)

eneeErr :: (Monad m, Exception err, Nullable elo)
        => (Stream eli -> Iteratee eli m a) -> err -> Iteratee elo m ()
eneeErr iter = liftM (const ()) . lift . run . iter . EOF . Just . toException

insertOut :: MonadIO m
          => Int
          -> (ZStream -> CInt -> IO CInt)
          -> Initial
          -> Enumeratee ByteString ByteString m a
insertOut size runf (Initial zstr) iter = do
    _out <- liftIO $ putOutBuffer size zstr

{-# LINE 454 "src/Bio/Iteratee/ZLib.hsc" #-}
    eneeCheckIfDone (fill size runf (EmptyIn zstr _out)) iter

fill :: MonadIO m
     => Int
     -> (ZStream -> CInt -> IO CInt)
     -> EmptyIn
     -> EnumerateeS ByteString ByteString m a
fill size run' (EmptyIn zstr _out) iter
    = let fill' (Chunk _in)
              | not (BS.null _in) = do
                  liftIO $ putInBuffer zstr _in

{-# LINE 469 "src/Bio/Iteratee/ZLib.hsc" #-}
                  doRun size run' (Invalid zstr _in _out) iter
              | otherwise = fillI
          fill' (EOF Nothing) = do
              out <- liftIO $ pullOutBuffer zstr _out
              eneeCheckIfDone (finish size run' (Finishing zstr BS.empty)) $ iter (Chunk out)
          fill' (EOF (Just err))
              = case fromException err of
                  Just err' -> flush size run' (Flushing zstr err' _out) iter
                  Nothing -> throwRecoverableErr err fill'

{-# LINE 483 "src/Bio/Iteratee/ZLib.hsc" #-}
          fillI = liftI fill'

{-# LINE 485 "src/Bio/Iteratee/ZLib.hsc" #-}
      in fillI

swapOut :: MonadIO m
        => Int
        -> (ZStream -> CInt -> IO CInt)
        -> FullOut
        -> Enumeratee ByteString ByteString m a
swapOut size run' (FullOut zstr _in) iter = do
    _out <- liftIO $ putOutBuffer size zstr

{-# LINE 497 "src/Bio/Iteratee/ZLib.hsc" #-}
    eneeCheckIfDone (doRun size run' (Invalid zstr _in _out)) iter

doRun :: MonadIO m
      => Int
      -> (ZStream -> CInt -> IO CInt)
      -> Invalid
      -> EnumerateeS ByteString ByteString m a
doRun size run' (Invalid zstr _in _out) iter = do

{-# LINE 509 "src/Bio/Iteratee/ZLib.hsc" #-}
    status <- liftIO $ run' zstr 0
{-# LINE 510 "src/Bio/Iteratee/ZLib.hsc" #-}

{-# LINE 513 "src/Bio/Iteratee/ZLib.hsc" #-}
    case fromErrno status of
        Left err -> do
            eneeErr iter err
            throwErr (toException err)
        Right False -> do -- End of stream
            remaining <- liftIO $ pullInBuffer zstr _in
            out <- liftIO $ pullOutBuffer zstr _out
            idone (iter (Chunk out)) (Chunk remaining)
        Right True -> do -- Continue
            (avail_in, avail_out) <- liftIO $ withZStream zstr $ \zptr -> do
                avail_in <- liftIO $ (\hsc_ptr -> peekByteOff hsc_ptr 8) zptr
{-# LINE 524 "src/Bio/Iteratee/ZLib.hsc" #-}
                avail_out <- liftIO $ (\hsc_ptr -> peekByteOff hsc_ptr 32) zptr
{-# LINE 525 "src/Bio/Iteratee/ZLib.hsc" #-}
                return (avail_in, avail_out) :: IO (CInt, CInt)
            case avail_out of
                0 -> do
                    out <- liftIO $ pullOutBuffer zstr _out
                    case avail_in of
                        0 -> insertOut size run' (Initial zstr) $ iter (Chunk out)
                        _ -> swapOut size run' (FullOut zstr _in) $ iter (Chunk out)
                _ -> case avail_in of
                    0 -> fill size run' (EmptyIn zstr _out) iter
                    _ -> do
                        eneeErr iter IncorrectState
                        throwErr (toException IncorrectState)

flush :: MonadIO m
      => Int
      -> (ZStream -> CInt -> IO CInt)
      -> Flushing
      -> EnumerateeS ByteString ByteString m a
flush size run' (Flushing zstr _flush _out) iter = do
    status <- liftIO $ run' zstr (fromFlush _flush)
    case fromErrno status of
        Left err -> do
            eneeErr iter err
            throwErr (toException err)
        Right False -> do -- Finished
            out <- liftIO $ pullOutBuffer zstr _out
            idone (iter (Chunk out)) (Chunk BS.empty)
        Right True -> do
            avail_out <- liftIO $ withZStream zstr (\hsc_ptr -> peekByteOff hsc_ptr 32)
{-# LINE 554 "src/Bio/Iteratee/ZLib.hsc" #-}
            case avail_out :: CInt of
                0 -> do
                    out <- liftIO $ pullOutBuffer zstr _out
                    out' <- liftIO $ putOutBuffer size zstr
                    eneeCheckIfDone (flush size run' (Flushing zstr _flush out')) $ iter (Chunk out)
                _ -> insertOut size run' (Initial zstr) (liftI iter)

finish :: MonadIO m
       => Int
       -> (ZStream -> CInt -> IO CInt)
       -> Finishing
       -> EnumerateeS ByteString ByteString m a
finish size run' fin@(Finishing zstr _in) iter = do

{-# LINE 571 "src/Bio/Iteratee/ZLib.hsc" #-}
    _out <- liftIO $ putOutBuffer size zstr
    status <- liftIO $ run' zstr 4
{-# LINE 573 "src/Bio/Iteratee/ZLib.hsc" #-}
    case fromErrno status of
        Left err -> do
            eneeErr iter err
            throwErr (toException err)
        Right False -> do -- Finished
            remaining <- liftIO $ pullInBuffer zstr _in
            out <- liftIO $ pullOutBuffer zstr _out
            idone (iter (Chunk out)) (Chunk remaining)
        Right True -> do
            avail_out <- liftIO $ withZStream zstr (\hsc_ptr -> peekByteOff hsc_ptr 32)
{-# LINE 583 "src/Bio/Iteratee/ZLib.hsc" #-}
            case avail_out :: CInt of
                0 -> do
                    out <- liftIO $ pullOutBuffer zstr _out
                    eneeCheckIfDone (finish size run' fin) $ iter (Chunk out)
                _ -> do
                    eneeErr iter IncorrectState
                    throwErr $! toException IncorrectState

foreign import ccall unsafe deflateInit2_ :: Ptr ZStream -> CInt -> CInt
                                          -> CInt -> CInt -> CInt
                                          -> CString -> CInt -> IO CInt
foreign import ccall unsafe inflateInit2_ :: Ptr ZStream -> CInt
                                          -> CString -> CInt -> IO CInt
foreign import ccall unsafe inflate :: Ptr ZStream -> CInt -> IO CInt
foreign import ccall unsafe deflate :: Ptr ZStream -> CInt -> IO CInt
foreign import ccall unsafe "&deflateEnd"
                              deflateEnd :: FunPtr (Ptr ZStream -> IO ())
foreign import ccall unsafe "&inflateEnd"
                              inflateEnd :: FunPtr (Ptr ZStream -> IO ())
foreign import ccall unsafe deflateSetDictionary :: Ptr ZStream -> Ptr Word8
                                                 -> CUInt -> IO CInt
foreign import ccall unsafe inflateSetDictionary :: Ptr ZStream -> Ptr Word8
                                                 -> CUInt -> IO CInt

deflateInit2 :: Ptr ZStream -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
deflateInit2 s l m wB mL s'
    = withCString "1.2.8" $ \v ->
{-# LINE 610 "src/Bio/Iteratee/ZLib.hsc" #-}
        deflateInit2_ s l m wB mL s' v (112)
{-# LINE 611 "src/Bio/Iteratee/ZLib.hsc" #-}

inflateInit2 :: Ptr ZStream -> CInt -> IO CInt
inflateInit2 s wB
    = withCString "1.2.8" $ \v ->
{-# LINE 615 "src/Bio/Iteratee/ZLib.hsc" #-}
        inflateInit2_ s wB v (112)
{-# LINE 616 "src/Bio/Iteratee/ZLib.hsc" #-}


{-# LINE 628 "src/Bio/Iteratee/ZLib.hsc" #-}
deflate' :: ZStream -> CInt -> IO CInt
deflate' z f = withZStream z $ \p -> deflate p f

inflate' :: ZStream -> CInt -> IO CInt
inflate' z f = withZStream z $ \p -> inflate p f

{-# LINE 634 "src/Bio/Iteratee/ZLib.hsc" #-}

mkCompress :: Format -> CompressParams
           -> IO (Either ZLibParamsException Initial)
mkCompress frm cp
    = case convParam frm cp of
        Left err -> return $! Left err
        Right (c, m, b, l, s) -> do
            zstr <- mallocForeignPtrBytes (112)
{-# LINE 642 "src/Bio/Iteratee/ZLib.hsc" #-}
            withForeignPtr zstr $ \zptr -> do
                _ <- memset (castPtr zptr) 0 (112)
{-# LINE 644 "src/Bio/Iteratee/ZLib.hsc" #-}
                _ <- deflateInit2 zptr c m b l s `finally`
                        addForeignPtrFinalizer deflateEnd zstr
                for_ (compressDictionary cp) $ \(PS fp off len) ->
                    withForeignPtr fp $ \ptr ->
                        deflateSetDictionary zptr (ptr `plusPtr` off)
                                                  (fromIntegral len)
            return $! Right $! Initial $ ZStream zstr

mkDecompress :: Format -> DecompressParams
             -> IO (Either ZLibParamsException (Initial, Maybe ByteString))
mkDecompress frm (DecompressParams w _ md)
    = case fromWindowBits frm w of
        Left err -> return $! Left err
        Right wB' -> do
            zstr <- mallocForeignPtrBytes (112)
{-# LINE 659 "src/Bio/Iteratee/ZLib.hsc" #-}
            v <- withForeignPtr zstr $ \zptr -> do
                _ <- memset (castPtr zptr) 0 (112)
{-# LINE 661 "src/Bio/Iteratee/ZLib.hsc" #-}
                _ <- inflateInit2 zptr wB' `finally`
                        addForeignPtrFinalizer inflateEnd zstr
                case (md, frm) of
                    (Just (PS fp off len), Raw) -> do
                        _ <- withForeignPtr fp $ \ptr ->
                                inflateSetDictionary zptr (ptr `plusPtr` off)
                                                          (fromIntegral len)
                        return Nothing
                    (Nothing, _) -> return $! Nothing
                    (Just bs, _) -> return $! (Just bs)
            return $! Right $! (Initial $ ZStream zstr, v)

-- User-related code

-- | Compress the input and send to inner iteratee.
enumDeflate :: MonadIO m
            => Format -- ^ Format of input
            -> CompressParams -- ^ Parameters of compression
            -> Enumeratee ByteString ByteString m a
enumDeflate f cp@(CompressParams _ _ _ _ _ size _) iter = do
    cmp <- liftIO $ mkCompress f cp
    case cmp of
        Left err -> do
            _ <- lift $ enumErr err iter
            throwErr (toException err)
        Right init' -> insertOut size deflate' init' iter

-- | Decompress the input and send to inner iteratee. If there is data
-- after the end of zlib stream, it is left unprocessed.
enumInflate :: MonadIO m
            => Format
            -> DecompressParams
            -> Enumeratee ByteString ByteString m a
enumInflate f dp@(DecompressParams _ size _md) iter = do
    dcmp <- liftIO $ mkDecompress f dp
    case dcmp of
        Left err -> do
            _ <- lift $ enumErr err iter
            throwErr (toException err)
        Right (init', Nothing) -> insertOut size inflate' init' iter
        Right (init', (Just (PS fp off len))) ->
            let inflate'' zstr param = do
                  ret <- inflate' zstr param
                  case fromErrno ret of
                      Left NeedDictionary -> do
                          _ <- withForeignPtr fp $ \ptr ->
                                  withZStream zstr $ \zptr ->
                                      inflateSetDictionary zptr (ptr `plusPtr` off)
                                                                (fromIntegral len)
                          inflate' zstr param
                      _ -> return ret
            in insertOut size inflate'' init' iter

-- | Inflate if Gzip format is recognized, otherwise pass through.
enumInflateAny :: MonadIO m => Enumeratee ByteString ByteString m a
enumInflateAny it = do magic <- iLookAhead $ liftM2 (,) tryHeadBS tryHeadBS
                       case magic of
                           (Just 0x1f, Just 0x8b) ->
                               enumInflate GZip defaultDecompressParams it
                               >>= enumInflateAny
                           _ -> mapChunks id it

enumSyncFlush :: Monad m => Enumerator ByteString m a
-- ^ Enumerate synchronise flush. It cause the all pending output to be flushed
-- and all available input is sent to inner Iteratee.
enumSyncFlush = enumErr SyncFlush

enumFullFlush :: Monad m => Enumerator ByteString m a
-- ^ Enumerate full flush. It flushes all pending output and reset the
-- compression. It allows to restart from this point if compressed data was
-- corrupted but it can affect the compression rate.
--
-- It may be only used during compression.
enumFullFlush = enumErr FullFlush

enumBlockFlush :: Monad m => Enumerator ByteString m a
-- ^ Enumerate block flush. If the enumerator is compressing it allows to
-- finish current block. If the enumerator is decompressing it forces to stop
-- on next block boundary.
enumBlockFlush = enumErr Block