{-# LINE 1 "Z/Compression/Zlib.hsc" #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module      : Z.Compression.Zlib
Description : The zlib
Copyright   : (c) Dong Han, 2017-2018
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable
This module provides <https://zlib.net zlib> bindings.
-}

module Z.Compression.Zlib(
  -- * Compression
    CompressConfig(..)
  , defaultCompressConfig
  , compress
  , compressSink
  , Strategy
  , pattern Z_FILTERED         
  , pattern Z_HUFFMAN_ONLY    
  , pattern Z_RLE             
  , pattern Z_FIXED           
  , pattern Z_DEFAULT_STRATEGY
  , CompressLevel
  , pattern Z_BEST_SPEED          
  , pattern Z_BEST_COMPRESSION   
  , pattern Z_DEFAULT_COMPRESSION
  , WindowBits
  , defaultWindowBits
  , MemLevel
  , defaultMemLevel
  -- * Decompression
  , DecompressConfig(..)
  , defaultDecompressConfig
  , decompress
  , decompressSource
  ) where

import           Control.Monad
import           Data.IORef
import           Data.Typeable
import           Data.Word
import           Foreign            hiding (void)
import           Foreign.C
import           GHC.Stack
import           System.IO.Unsafe   (unsafePerformIO)
import           Z.Data.Array       as A
import           Z.Data.CBytes      as CBytes
import           Z.Data.Vector.Base as V
import           Z.Foreign
import           Z.IO.Buffered
import           Z.IO.Exception



newtype Strategy = Strategy CInt deriving (Strategy -> Strategy -> Bool
(Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Bool) -> Eq Strategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Strategy -> Strategy -> Bool
$c/= :: Strategy -> Strategy -> Bool
== :: Strategy -> Strategy -> Bool
$c== :: Strategy -> Strategy -> Bool
Eq, Eq Strategy
Eq Strategy
-> (Strategy -> Strategy -> Ordering)
-> (Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Strategy)
-> (Strategy -> Strategy -> Strategy)
-> Ord Strategy
Strategy -> Strategy -> Bool
Strategy -> Strategy -> Ordering
Strategy -> Strategy -> Strategy
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
min :: Strategy -> Strategy -> Strategy
$cmin :: Strategy -> Strategy -> Strategy
max :: Strategy -> Strategy -> Strategy
$cmax :: Strategy -> Strategy -> Strategy
>= :: Strategy -> Strategy -> Bool
$c>= :: Strategy -> Strategy -> Bool
> :: Strategy -> Strategy -> Bool
$c> :: Strategy -> Strategy -> Bool
<= :: Strategy -> Strategy -> Bool
$c<= :: Strategy -> Strategy -> Bool
< :: Strategy -> Strategy -> Bool
$c< :: Strategy -> Strategy -> Bool
compare :: Strategy -> Strategy -> Ordering
$ccompare :: Strategy -> Strategy -> Ordering
$cp1Ord :: Eq Strategy
Ord, Int -> Strategy -> ShowS
[Strategy] -> ShowS
Strategy -> String
(Int -> Strategy -> ShowS)
-> (Strategy -> String) -> ([Strategy] -> ShowS) -> Show Strategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Strategy] -> ShowS
$cshowList :: [Strategy] -> ShowS
show :: Strategy -> String
$cshow :: Strategy -> String
showsPrec :: Int -> Strategy -> ShowS
$cshowsPrec :: Int -> Strategy -> ShowS
Show, Typeable)

pattern $bZ_FILTERED :: Strategy
$mZ_FILTERED :: forall r. Strategy -> (Void# -> r) -> (Void# -> r) -> r
Z_FILTERED           = Strategy (1)
{-# LINE 69 "Z/Compression/Zlib.hsc" #-}
pattern Z_HUFFMAN_ONLY       = Strategy (2)
{-# LINE 70 "Z/Compression/Zlib.hsc" #-}
pattern Z_RLE                = Strategy (3)
{-# LINE 71 "Z/Compression/Zlib.hsc" #-}
pattern Z_FIXED              = Strategy (4)
{-# LINE 72 "Z/Compression/Zlib.hsc" #-}
pattern Z_DEFAULT_STRATEGY   = Strategy (0)
{-# LINE 73 "Z/Compression/Zlib.hsc" #-}


newtype CompressLevel = CompressLevel CInt deriving (CompressLevel -> CompressLevel -> Bool
(CompressLevel -> CompressLevel -> Bool)
-> (CompressLevel -> CompressLevel -> Bool) -> Eq CompressLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressLevel -> CompressLevel -> Bool
$c/= :: CompressLevel -> CompressLevel -> Bool
== :: CompressLevel -> CompressLevel -> Bool
$c== :: CompressLevel -> CompressLevel -> Bool
Eq, Eq CompressLevel
Eq CompressLevel
-> (CompressLevel -> CompressLevel -> Ordering)
-> (CompressLevel -> CompressLevel -> Bool)
-> (CompressLevel -> CompressLevel -> Bool)
-> (CompressLevel -> CompressLevel -> Bool)
-> (CompressLevel -> CompressLevel -> Bool)
-> (CompressLevel -> CompressLevel -> CompressLevel)
-> (CompressLevel -> CompressLevel -> CompressLevel)
-> Ord CompressLevel
CompressLevel -> CompressLevel -> Bool
CompressLevel -> CompressLevel -> Ordering
CompressLevel -> CompressLevel -> CompressLevel
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
min :: CompressLevel -> CompressLevel -> CompressLevel
$cmin :: CompressLevel -> CompressLevel -> CompressLevel
max :: CompressLevel -> CompressLevel -> CompressLevel
$cmax :: CompressLevel -> CompressLevel -> CompressLevel
>= :: CompressLevel -> CompressLevel -> Bool
$c>= :: CompressLevel -> CompressLevel -> Bool
> :: CompressLevel -> CompressLevel -> Bool
$c> :: CompressLevel -> CompressLevel -> Bool
<= :: CompressLevel -> CompressLevel -> Bool
$c<= :: CompressLevel -> CompressLevel -> Bool
< :: CompressLevel -> CompressLevel -> Bool
$c< :: CompressLevel -> CompressLevel -> Bool
compare :: CompressLevel -> CompressLevel -> Ordering
$ccompare :: CompressLevel -> CompressLevel -> Ordering
$cp1Ord :: Eq CompressLevel
Ord, Int -> CompressLevel -> ShowS
[CompressLevel] -> ShowS
CompressLevel -> String
(Int -> CompressLevel -> ShowS)
-> (CompressLevel -> String)
-> ([CompressLevel] -> ShowS)
-> Show CompressLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressLevel] -> ShowS
$cshowList :: [CompressLevel] -> ShowS
show :: CompressLevel -> String
$cshow :: CompressLevel -> String
showsPrec :: Int -> CompressLevel -> ShowS
$cshowsPrec :: Int -> CompressLevel -> ShowS
Show, Typeable)

-- pattern Z_NO_COMPRESSION       =  CompressLevel (#const Z_NO_COMPRESSION     )
pattern $bZ_BEST_SPEED :: CompressLevel
$mZ_BEST_SPEED :: forall r. CompressLevel -> (Void# -> r) -> (Void# -> r) -> r
Z_BEST_SPEED           =  CompressLevel (1)
{-# LINE 79 "Z/Compression/Zlib.hsc" #-}
pattern Z_BEST_COMPRESSION     =  CompressLevel (9)
{-# LINE 80 "Z/Compression/Zlib.hsc" #-}
pattern Z_DEFAULT_COMPRESSION  =  CompressLevel (-1)
{-# LINE 81 "Z/Compression/Zlib.hsc" #-}

{- | The 'WindowBits' is the base two logarithm of the maximum window size (the size of the history buffer).
It should be in the range 8..15 for this version of the library. The 'defaultWindowBits' value is 15. Decompressing windowBits must be greater than or equal to the compressing windowBits. If a compressed stream with a larger window size is given as input, decompress will throw 'ZDataError'
windowBits can also be –8..–15 for raw inflate. In this case, -windowBits determines the window size. inflate() will then process raw deflate data, not looking for a zlib or gzip header, not generating a check value, and not looking for any check values for comparison at the end of the stream.
windowBits can also be greater than 15 for optional gzip decoding. Add 32 to windowBits to enable zlib and gzip decoding with automatic header detection, or add 16 to decode only the gzip format.
-}
newtype WindowBits = WindowBits CInt
    deriving (WindowBits -> WindowBits -> Bool
(WindowBits -> WindowBits -> Bool)
-> (WindowBits -> WindowBits -> Bool) -> Eq WindowBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowBits -> WindowBits -> Bool
$c/= :: WindowBits -> WindowBits -> Bool
== :: WindowBits -> WindowBits -> Bool
$c== :: 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
min :: WindowBits -> WindowBits -> WindowBits
$cmin :: WindowBits -> WindowBits -> WindowBits
max :: WindowBits -> WindowBits -> WindowBits
$cmax :: WindowBits -> WindowBits -> WindowBits
>= :: WindowBits -> WindowBits -> Bool
$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
compare :: WindowBits -> WindowBits -> Ordering
$ccompare :: WindowBits -> WindowBits -> Ordering
$cp1Ord :: Eq WindowBits
Ord, ReadPrec [WindowBits]
ReadPrec WindowBits
Int -> ReadS WindowBits
ReadS [WindowBits]
(Int -> ReadS WindowBits)
-> ReadS [WindowBits]
-> ReadPrec WindowBits
-> ReadPrec [WindowBits]
-> Read WindowBits
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowBits]
$creadListPrec :: ReadPrec [WindowBits]
readPrec :: ReadPrec WindowBits
$creadPrec :: ReadPrec WindowBits
readList :: ReadS [WindowBits]
$creadList :: ReadS [WindowBits]
readsPrec :: Int -> ReadS WindowBits
$creadsPrec :: Int -> ReadS WindowBits
Read, 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
showList :: [WindowBits] -> ShowS
$cshowList :: [WindowBits] -> ShowS
show :: WindowBits -> String
$cshow :: WindowBits -> String
showsPrec :: Int -> WindowBits -> ShowS
$cshowsPrec :: Int -> WindowBits -> ShowS
Show, Integer -> WindowBits
WindowBits -> WindowBits
WindowBits -> WindowBits -> WindowBits
(WindowBits -> WindowBits -> WindowBits)
-> (WindowBits -> WindowBits -> WindowBits)
-> (WindowBits -> WindowBits -> WindowBits)
-> (WindowBits -> WindowBits)
-> (WindowBits -> WindowBits)
-> (WindowBits -> WindowBits)
-> (Integer -> WindowBits)
-> Num WindowBits
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WindowBits
$cfromInteger :: Integer -> WindowBits
signum :: WindowBits -> WindowBits
$csignum :: WindowBits -> WindowBits
abs :: WindowBits -> WindowBits
$cabs :: WindowBits -> WindowBits
negate :: WindowBits -> WindowBits
$cnegate :: WindowBits -> WindowBits
* :: WindowBits -> WindowBits -> WindowBits
$c* :: WindowBits -> WindowBits -> WindowBits
- :: WindowBits -> WindowBits -> WindowBits
$c- :: WindowBits -> WindowBits -> WindowBits
+ :: WindowBits -> WindowBits -> WindowBits
$c+ :: WindowBits -> WindowBits -> WindowBits
Num, Typeable)

defaultWindowBits :: WindowBits
defaultWindowBits :: WindowBits
defaultWindowBits = CInt -> WindowBits
WindowBits CInt
15

-- | The 'MemLevel' specifies how much memory should be allocated for the internal compression state. 1 uses minimum memory but is slow and reduces compression ratio; 9 uses maximum memory for optimal speed. The default value is 8.
newtype MemLevel = MemLevel CInt
    deriving (MemLevel -> MemLevel -> Bool
(MemLevel -> MemLevel -> Bool)
-> (MemLevel -> MemLevel -> Bool) -> Eq MemLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemLevel -> MemLevel -> Bool
$c/= :: MemLevel -> MemLevel -> Bool
== :: MemLevel -> MemLevel -> Bool
$c== :: MemLevel -> MemLevel -> Bool
Eq, Eq MemLevel
Eq MemLevel
-> (MemLevel -> MemLevel -> Ordering)
-> (MemLevel -> MemLevel -> Bool)
-> (MemLevel -> MemLevel -> Bool)
-> (MemLevel -> MemLevel -> Bool)
-> (MemLevel -> MemLevel -> Bool)
-> (MemLevel -> MemLevel -> MemLevel)
-> (MemLevel -> MemLevel -> MemLevel)
-> Ord MemLevel
MemLevel -> MemLevel -> Bool
MemLevel -> MemLevel -> Ordering
MemLevel -> MemLevel -> MemLevel
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
min :: MemLevel -> MemLevel -> MemLevel
$cmin :: MemLevel -> MemLevel -> MemLevel
max :: MemLevel -> MemLevel -> MemLevel
$cmax :: MemLevel -> MemLevel -> MemLevel
>= :: MemLevel -> MemLevel -> Bool
$c>= :: MemLevel -> MemLevel -> Bool
> :: MemLevel -> MemLevel -> Bool
$c> :: MemLevel -> MemLevel -> Bool
<= :: MemLevel -> MemLevel -> Bool
$c<= :: MemLevel -> MemLevel -> Bool
< :: MemLevel -> MemLevel -> Bool
$c< :: MemLevel -> MemLevel -> Bool
compare :: MemLevel -> MemLevel -> Ordering
$ccompare :: MemLevel -> MemLevel -> Ordering
$cp1Ord :: Eq MemLevel
Ord, ReadPrec [MemLevel]
ReadPrec MemLevel
Int -> ReadS MemLevel
ReadS [MemLevel]
(Int -> ReadS MemLevel)
-> ReadS [MemLevel]
-> ReadPrec MemLevel
-> ReadPrec [MemLevel]
-> Read MemLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MemLevel]
$creadListPrec :: ReadPrec [MemLevel]
readPrec :: ReadPrec MemLevel
$creadPrec :: ReadPrec MemLevel
readList :: ReadS [MemLevel]
$creadList :: ReadS [MemLevel]
readsPrec :: Int -> ReadS MemLevel
$creadsPrec :: Int -> ReadS MemLevel
Read, Int -> MemLevel -> ShowS
[MemLevel] -> ShowS
MemLevel -> String
(Int -> MemLevel -> ShowS)
-> (MemLevel -> String) -> ([MemLevel] -> ShowS) -> Show MemLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemLevel] -> ShowS
$cshowList :: [MemLevel] -> ShowS
show :: MemLevel -> String
$cshow :: MemLevel -> String
showsPrec :: Int -> MemLevel -> ShowS
$cshowsPrec :: Int -> MemLevel -> ShowS
Show, Integer -> MemLevel
MemLevel -> MemLevel
MemLevel -> MemLevel -> MemLevel
(MemLevel -> MemLevel -> MemLevel)
-> (MemLevel -> MemLevel -> MemLevel)
-> (MemLevel -> MemLevel -> MemLevel)
-> (MemLevel -> MemLevel)
-> (MemLevel -> MemLevel)
-> (MemLevel -> MemLevel)
-> (Integer -> MemLevel)
-> Num MemLevel
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> MemLevel
$cfromInteger :: Integer -> MemLevel
signum :: MemLevel -> MemLevel
$csignum :: MemLevel -> MemLevel
abs :: MemLevel -> MemLevel
$cabs :: MemLevel -> MemLevel
negate :: MemLevel -> MemLevel
$cnegate :: MemLevel -> MemLevel
* :: MemLevel -> MemLevel -> MemLevel
$c* :: MemLevel -> MemLevel -> MemLevel
- :: MemLevel -> MemLevel -> MemLevel
$c- :: MemLevel -> MemLevel -> MemLevel
+ :: MemLevel -> MemLevel -> MemLevel
$c+ :: MemLevel -> MemLevel -> MemLevel
Num, Typeable)

defaultMemLevel :: MemLevel
defaultMemLevel :: MemLevel
defaultMemLevel = CInt -> MemLevel
MemLevel CInt
9

data CompressConfig = CompressConfig
    { CompressConfig -> CompressLevel
compressLevel :: CompressLevel
    , CompressConfig -> WindowBits
compressWindowBits :: WindowBits
    , CompressConfig -> MemLevel
compressMemoryLevel :: MemLevel
    , CompressConfig -> CBytes
compressDictionary :: CBytes
    , CompressConfig -> Strategy
compressStrategy :: Strategy
    }

defaultCompressConfig :: CompressConfig
defaultCompressConfig :: CompressConfig
defaultCompressConfig =
    CompressLevel
-> WindowBits -> MemLevel -> CBytes -> Strategy -> CompressConfig
CompressConfig CompressLevel
Z_DEFAULT_COMPRESSION  WindowBits
defaultWindowBits
        MemLevel
defaultMemLevel CBytes
CBytes.empty Strategy
Z_DEFAULT_STRATEGY

-- | Compress all the data written to a output.
--
compressSink :: HasCallStack
           => CompressConfig
           -> Sink V.Bytes
           -> IO (Sink V.Bytes)
compressSink :: CompressConfig -> Sink Bytes -> IO (Sink Bytes)
compressSink (CompressConfig CompressLevel
level WindowBits
windowBits MemLevel
memLevel CBytes
dict Strategy
strategy) (Bytes -> IO ()
write, IO ()
flush) = do
    ForeignPtr ZStream
zs <- FinalizerPtr ZStream -> Ptr ZStream -> IO (ForeignPtr ZStream)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStream
free_z_stream_deflate (Ptr ZStream -> IO (ForeignPtr ZStream))
-> IO (Ptr ZStream) -> IO (ForeignPtr ZStream)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr ZStream)
create_z_stream
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
    ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf Int
bufSiz
    IORef (MutablePrimArray RealWorld Word8)
bufRef <- MutablePrimArray RealWorld Word8
-> IO (IORef (MutablePrimArray RealWorld Word8))
forall a. a -> IO (IORef a)
newIORef MutablePrimArray RealWorld Word8
buf

    ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwZlibIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ZStream
-> CompressLevel -> WindowBits -> MemLevel -> Strategy -> IO CInt
deflate_init2 Ptr ZStream
ps CompressLevel
level WindowBits
windowBits MemLevel
memLevel Strategy
strategy
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CBytes -> Bool
CBytes.null CBytes
dict) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwZlibIfMinus_ (IO CInt -> IO ())
-> ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (CString -> IO CInt) -> IO CInt
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
dict ((CString -> IO CInt) -> IO ()) -> (CString -> IO CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
pdict ->
            Ptr ZStream -> CString -> CUInt -> IO CInt
deflateSetDictionary Ptr ZStream
ps CString
pdict (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ CBytes -> Int
CBytes.length CBytes
dict)

    Sink Bytes -> IO (Sink Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Bytes -> IO ()
zwrite ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef, ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zflush ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef)

  where
    bufSiz :: Int
bufSiz = Int
V.defaultChunkSize

    zwrite :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Bytes -> IO ()
zwrite ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef Bytes
input = do
        ForeignPtr ZStream -> Bytes -> Int -> IO ()
set_avail_in ForeignPtr ZStream
zs Bytes
input (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
input)
        ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef

    zloop :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef = do
        CUInt
oavail :: CUInt <- ForeignPtr ZStream -> (Ptr ZStream -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO CUInt) -> IO CUInt)
-> (Ptr ZStream -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwZlibIfMinus_ (Ptr ZStream -> CInt -> IO CInt
deflate Ptr ZStream
ps (CInt
0))
{-# LINE 143 "Z/Compression/Zlib.hsc" #-}
            ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZStream
hsc_ptr Int
32)) Ptr ZStream
ps
{-# LINE 144 "Z/Compression/Zlib.hsc" #-}

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
oavail CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            PrimArray Word8
oarr <- MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr (MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8))
-> IO (MutablePrimArray RealWorld Word8) -> IO (PrimArray Word8)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
bufRef
            MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
            ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf' Int
bufSiz
            IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
bufRef MutablePrimArray RealWorld Word8
buf'
            Bytes -> IO ()
write (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
oarr Int
0 Int
bufSiz)
            ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef

    zflush :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zflush ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef = do
        CInt
r :: CInt <- ForeignPtr ZStream -> (Ptr ZStream -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO CInt) -> IO CInt)
-> (Ptr ZStream -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
            CInt
r <- HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwZlibIfMinus (Ptr ZStream -> CInt -> IO CInt
deflate Ptr ZStream
ps (CInt
4))
{-# LINE 156 "Z/Compression/Zlib.hsc" #-}
            CUInt
oavail :: CUInt <- ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZStream
hsc_ptr Int
32)) Ptr ZStream
ps
{-# LINE 157 "Z/Compression/Zlib.hsc" #-}
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
oavail CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSiz) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                PrimArray Word8
oarr <- MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr (MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8))
-> IO (MutablePrimArray RealWorld Word8) -> IO (PrimArray Word8)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
bufRef
                Bytes -> IO ()
write (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
oarr Int
0 (Int
bufSiz Int -> Int -> Int
forall a. Num a => a -> a -> a
- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oavail))
                IO ()
flush
            CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
r

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= (CInt
1)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
{-# LINE 164 "Z/Compression/Zlib.hsc" #-}
            MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
            ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf' Int
bufSiz
            IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
bufRef MutablePrimArray RealWorld Word8
buf'
            ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> IO ()
zflush ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef

-- | Compress some bytes.
compress :: HasCallStack => CompressConfig -> V.Bytes -> V.Bytes
compress :: CompressConfig -> Bytes -> Bytes
compress CompressConfig
conf Bytes
input = IO Bytes -> Bytes
forall a. IO a -> a
unsafePerformIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ do
    IORef [Bytes]
ref <- [Bytes] -> IO (IORef [Bytes])
forall a. a -> IO (IORef a)
newIORef []
    (Bytes -> IO ()
write, IO ()
flush) <- HasCallStack => CompressConfig -> Sink Bytes -> IO (Sink Bytes)
CompressConfig -> Sink Bytes -> IO (Sink Bytes)
compressSink CompressConfig
conf (\ Bytes
x -> IORef [Bytes] -> ([Bytes] -> [Bytes]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [Bytes]
ref (Bytes
xBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Bytes -> IO ()
write Bytes
input
    IO ()
flush
    [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> Bytes) -> ([Bytes] -> [Bytes]) -> [Bytes] -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse ([Bytes] -> Bytes) -> IO [Bytes] -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [Bytes] -> IO [Bytes]
forall a. IORef a -> IO a
readIORef IORef [Bytes]
ref


{-
compressBuilderStream :: HasCallStack
                      => CompressConfig
                      -> (B.Builder a -> IO ())
                      -> IO (B.Builder a -> IO ())


-}

data DecompressConfig = DecompressConfig
    { DecompressConfig -> WindowBits
decompressWindowBits :: WindowBits
    , DecompressConfig -> CBytes
decompressDictionary :: CBytes
    }

defaultDecompressConfig :: DecompressConfig
defaultDecompressConfig :: DecompressConfig
defaultDecompressConfig = WindowBits -> CBytes -> DecompressConfig
DecompressConfig WindowBits
defaultWindowBits CBytes
CBytes.empty

-- | Decompress bytes from source.
decompressSource :: DecompressConfig
                 -> Source V.Bytes
                 -> IO (Source V.Bytes)
decompressSource :: DecompressConfig -> Source Bytes -> IO (Source Bytes)
decompressSource (DecompressConfig WindowBits
windowBits CBytes
dict) Source Bytes
source = do 
    ForeignPtr ZStream
zs <- FinalizerPtr ZStream -> Ptr ZStream -> IO (ForeignPtr ZStream)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ZStream
free_z_stream_inflate (Ptr ZStream -> IO (ForeignPtr ZStream))
-> IO (Ptr ZStream) -> IO (ForeignPtr ZStream)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr ZStream)
create_z_stream
    MutablePrimArray RealWorld Word8
buf <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
    ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf Int
bufSiz
    IORef (MutablePrimArray RealWorld Word8)
bufRef <- MutablePrimArray RealWorld Word8
-> IO (IORef (MutablePrimArray RealWorld Word8))
forall a. a -> IO (IORef a)
newIORef MutablePrimArray RealWorld Word8
buf

    ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwZlibIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ZStream -> WindowBits -> IO CInt
inflate_init2 Ptr ZStream
ps WindowBits
windowBits

    Source Bytes -> IO (Source Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zread ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef)
  where
    bufSiz :: Int
bufSiz = Int
V.defaultChunkSize
    
    zread :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zread ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef = do 
        Int
bufLen <- MutablePrimArray RealWorld Word8 -> IO Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m Int
A.sizeofMutableArr (MutablePrimArray RealWorld Word8 -> IO Int)
-> IO (MutablePrimArray RealWorld Word8) -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
bufRef 
        if Int
bufLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Maybe Bytes -> Source Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bytes
forall a. Maybe a
Nothing
        else do
            CUInt
oavail :: CUInt <- ForeignPtr ZStream -> (Ptr ZStream -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZStream
hsc_ptr Int
32))
{-# LINE 219 "Z/Compression/Zlib.hsc" #-}
            if (CUInt
oavail CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0) 
            then do
                PrimArray Word8
oarr <- MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr (MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8))
-> IO (MutablePrimArray RealWorld Word8) -> IO (PrimArray Word8)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
bufRef
                MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
                ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf' Int
bufSiz
                IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
bufRef MutablePrimArray RealWorld Word8
buf'
                Maybe Bytes -> Source Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
oarr Int
0 Int
bufSiz))
            else ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef 

    zloop :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef  = do
        CUInt
iavail :: CUInt <- ForeignPtr ZStream -> (Ptr ZStream -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZStream
hsc_ptr Int
8)) 
{-# LINE 230 "Z/Compression/Zlib.hsc" #-}
        if CUInt
iavail CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0
        then do
            Maybe Bytes
input <- Source Bytes
source
            case Maybe Bytes
input of
                Just Bytes
input' -> do
                    ForeignPtr ZStream -> Bytes -> Int -> IO ()
set_avail_in ForeignPtr ZStream
zs Bytes
input' (Bytes -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Bytes
input')
                    ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
                        CInt
r <- HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwZlibIfMinus (Ptr ZStream -> CInt -> IO CInt
inflate Ptr ZStream
ps (CInt
0))
{-# LINE 238 "Z/Compression/Zlib.hsc" #-}
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
2) Bool -> Bool -> Bool
&& Bool -> Bool
not (CBytes -> Bool
CBytes.null CBytes
dict)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
{-# LINE 239 "Z/Compression/Zlib.hsc" #-}
                            throwZlibIfMinus_ . withCBytes dict $ \ pdict ->
                                inflateSetDictionary ps pdict (fromIntegral $ CBytes.length dict)
                    ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zread ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef 
                Maybe Bytes
_ -> ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8)
-> [Bytes]
-> Source Bytes
zfinish ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef []
        else do
            ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps ->
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwZlibIfMinus_ (Ptr ZStream -> CInt -> IO CInt
inflate Ptr ZStream
ps (CInt
0))
{-# LINE 246 "Z/Compression/Zlib.hsc" #-}
            ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8) -> Source Bytes
zloop ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef 

    zfinish :: ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8)
-> [Bytes]
-> Source Bytes
zfinish ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef [Bytes]
acc = do
        CInt
r <- ForeignPtr ZStream -> (Ptr ZStream -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO CInt) -> IO CInt)
-> (Ptr ZStream -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
            HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwZlibIfMinus (Ptr ZStream -> CInt -> IO CInt
inflate Ptr ZStream
ps (CInt
4))
{-# LINE 251 "Z/Compression/Zlib.hsc" #-}

        CUInt
oavail :: CUInt <- ForeignPtr ZStream -> (Ptr ZStream -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ZStream
hsc_ptr Int
32)) 
{-# LINE 253 "Z/Compression/Zlib.hsc" #-}
        PrimArray Word8
oarr <- MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
A.unsafeFreezeArr (MutablePrimArray RealWorld Word8 -> IO (PrimArray Word8))
-> IO (MutablePrimArray RealWorld Word8) -> IO (PrimArray Word8)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (MutablePrimArray RealWorld Word8)
-> IO (MutablePrimArray RealWorld Word8)
forall a. IORef a -> IO a
readIORef IORef (MutablePrimArray RealWorld Word8)
bufRef
        let !v :: Bytes
v = PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
V.PrimVector PrimArray Word8
oarr Int
0 (Int
bufSiz Int -> Int -> Int
forall a. Num a => a -> a -> a
- CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
oavail)

        if (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
1)) 
{-# LINE 257 "Z/Compression/Zlib.hsc" #-}
        then do
            IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
bufRef (MutablePrimArray RealWorld Word8 -> IO ())
-> IO (MutablePrimArray RealWorld Word8) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (MArr PrimArray RealWorld Word8)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
A.newArr Int
0
            let !v' :: Bytes
v' = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> [Bytes]
forall a. [a] -> [a]
reverse (Bytes
vBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc))
            Maybe Bytes -> Source Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes -> Maybe Bytes
forall a. a -> Maybe a
Just Bytes
v')
        else do
            MutablePrimArray RealWorld Word8
buf' <- Int -> IO (MutablePrimArray (PrimState IO) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
A.newPinnedPrimArray Int
bufSiz
            ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf' Int
bufSiz
            IORef (MutablePrimArray RealWorld Word8)
-> MutablePrimArray RealWorld Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (MutablePrimArray RealWorld Word8)
bufRef MutablePrimArray RealWorld Word8
buf'
            ForeignPtr ZStream
-> IORef (MutablePrimArray RealWorld Word8)
-> [Bytes]
-> Source Bytes
zfinish ForeignPtr ZStream
zs IORef (MutablePrimArray RealWorld Word8)
bufRef (Bytes
vBytes -> [Bytes] -> [Bytes]
forall a. a -> [a] -> [a]
:[Bytes]
acc)

    
-- | Decompress some bytes.
decompress :: HasCallStack => DecompressConfig -> V.Bytes -> V.Bytes
decompress :: DecompressConfig -> Bytes -> Bytes
decompress DecompressConfig
conf Bytes
input = [Bytes] -> Bytes
forall (v :: * -> *) a. Vec v a => [v a] -> v a
V.concat ([Bytes] -> Bytes)
-> (IO [Bytes] -> [Bytes]) -> IO [Bytes] -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Bytes] -> [Bytes]
forall a. IO a -> a
unsafePerformIO (IO [Bytes] -> Bytes) -> IO [Bytes] -> Bytes
forall a b. (a -> b) -> a -> b
$ do
     Source Bytes -> IO [Bytes]
forall a. Source a -> IO [a]
collectSource (Source Bytes -> IO [Bytes]) -> IO (Source Bytes) -> IO [Bytes]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecompressConfig -> Source Bytes -> IO (Source Bytes)
decompressSource DecompressConfig
conf (Source Bytes -> IO (Source Bytes))
-> IO (Source Bytes) -> IO (Source Bytes)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Bytes] -> IO (Source Bytes)
forall a. [a] -> IO (Source a)
sourceFromList [Bytes
input]

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

newtype ZReturn = ZReturn CInt deriving (ZReturn -> ZReturn -> Bool
(ZReturn -> ZReturn -> Bool)
-> (ZReturn -> ZReturn -> Bool) -> Eq ZReturn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZReturn -> ZReturn -> Bool
$c/= :: ZReturn -> ZReturn -> Bool
== :: ZReturn -> ZReturn -> Bool
$c== :: ZReturn -> ZReturn -> Bool
Eq, Eq ZReturn
Eq ZReturn
-> (ZReturn -> ZReturn -> Ordering)
-> (ZReturn -> ZReturn -> Bool)
-> (ZReturn -> ZReturn -> Bool)
-> (ZReturn -> ZReturn -> Bool)
-> (ZReturn -> ZReturn -> Bool)
-> (ZReturn -> ZReturn -> ZReturn)
-> (ZReturn -> ZReturn -> ZReturn)
-> Ord ZReturn
ZReturn -> ZReturn -> Bool
ZReturn -> ZReturn -> Ordering
ZReturn -> ZReturn -> ZReturn
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
min :: ZReturn -> ZReturn -> ZReturn
$cmin :: ZReturn -> ZReturn -> ZReturn
max :: ZReturn -> ZReturn -> ZReturn
$cmax :: ZReturn -> ZReturn -> ZReturn
>= :: ZReturn -> ZReturn -> Bool
$c>= :: ZReturn -> ZReturn -> Bool
> :: ZReturn -> ZReturn -> Bool
$c> :: ZReturn -> ZReturn -> Bool
<= :: ZReturn -> ZReturn -> Bool
$c<= :: ZReturn -> ZReturn -> Bool
< :: ZReturn -> ZReturn -> Bool
$c< :: ZReturn -> ZReturn -> Bool
compare :: ZReturn -> ZReturn -> Ordering
$ccompare :: ZReturn -> ZReturn -> Ordering
$cp1Ord :: Eq ZReturn
Ord, Int -> ZReturn -> ShowS
[ZReturn] -> ShowS
ZReturn -> String
(Int -> ZReturn -> ShowS)
-> (ZReturn -> String) -> ([ZReturn] -> ShowS) -> Show ZReturn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZReturn] -> ShowS
$cshowList :: [ZReturn] -> ShowS
show :: ZReturn -> String
$cshow :: ZReturn -> String
showsPrec :: Int -> ZReturn -> ShowS
$cshowsPrec :: Int -> ZReturn -> ShowS
Show, Typeable)

toZErrorMsg :: CInt -> CBytes
toZErrorMsg :: CInt -> CBytes
toZErrorMsg (CInt
0) =  CBytes
"Z_OK"
{-# LINE 279 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (1) =  "Z_STREAM_END"
{-# LINE 280 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (2) =  "Z_NEED_DICT"
{-# LINE 281 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-1) =  "Z_ERRNO"
{-# LINE 282 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-2) =  "Z_STREAM_ERROR"
{-# LINE 283 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-3) =  "Z_DATA_ERROR"
{-# LINE 284 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-4) =  "Z_MEM_ERROR"
{-# LINE 285 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-5) =  "Z_BUF_ERROR"
{-# LINE 286 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg (-6) =  "Z_VERSION_ERROR"
{-# LINE 287 "Z/Compression/Zlib.hsc" #-}
toZErrorMsg _                        =  "Z_UNEXPECTED"

data ZlibException = ZlibException CBytes CallStack deriving (Int -> ZlibException -> ShowS
[ZlibException] -> ShowS
ZlibException -> String
(Int -> ZlibException -> ShowS)
-> (ZlibException -> String)
-> ([ZlibException] -> ShowS)
-> Show ZlibException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZlibException] -> ShowS
$cshowList :: [ZlibException] -> ShowS
show :: ZlibException -> String
$cshow :: ZlibException -> String
showsPrec :: Int -> ZlibException -> ShowS
$cshowsPrec :: Int -> ZlibException -> ShowS
Show, Typeable)
instance Exception ZlibException

throwZlibIfMinus :: HasCallStack => IO CInt -> IO CInt
throwZlibIfMinus :: IO CInt -> IO CInt
throwZlibIfMinus IO CInt
f = do
    CInt
r <- IO CInt
f
    if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 Bool -> Bool -> Bool
&& CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= (-CInt
5)
{-# LINE 296 "Z/Compression/Zlib.hsc" #-}
    then ZlibException -> IO CInt
forall e a. Exception e => e -> IO a
throwIO (CBytes -> CallStack -> ZlibException
ZlibException (CInt -> CBytes
toZErrorMsg CInt
r) CallStack
HasCallStack => CallStack
callStack)
    else CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
r

throwZlibIfMinus_ :: HasCallStack => IO CInt -> IO ()
throwZlibIfMinus_ :: IO CInt -> IO ()
throwZlibIfMinus_ = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (IO CInt -> IO CInt) -> IO CInt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwZlibIfMinus

data ZStream

foreign import ccall unsafe
    create_z_stream :: IO (Ptr ZStream)

foreign import ccall unsafe "hs_zlib.c &free_z_stream_inflate"
    free_z_stream_inflate :: FunPtr (Ptr ZStream -> IO ())

foreign import ccall unsafe "hs_zlib.c &free_z_stream_deflate"
    free_z_stream_deflate :: FunPtr (Ptr ZStream -> IO ())

foreign import ccall unsafe
    deflate_init2 :: Ptr ZStream -> CompressLevel -> WindowBits -> MemLevel -> Strategy -> IO CInt

foreign import ccall unsafe
    deflateSetDictionary :: Ptr ZStream -> CString -> CUInt -> IO CInt

foreign import ccall unsafe
    deflate :: Ptr ZStream -> CInt -> IO CInt

foreign import ccall unsafe
    deflateEnd :: Ptr ZStream -> IO CInt

foreign import ccall unsafe
    inflate_init2 :: Ptr ZStream -> WindowBits -> IO CInt

foreign import ccall unsafe
    inflateSetDictionary :: Ptr ZStream -> CString -> CUInt -> IO CInt

foreign import ccall unsafe
    inflate :: Ptr ZStream -> CInt -> IO CInt

foreign import ccall unsafe
    inflateEnd :: Ptr ZStream -> IO CInt


set_avail_in :: ForeignPtr ZStream -> V.Bytes -> Int -> IO ()
set_avail_in :: ForeignPtr ZStream -> Bytes -> Int -> IO ()
set_avail_in ForeignPtr ZStream
zs Bytes
buf Int
buflen = do
    Bytes -> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (Ptr a -> Int -> IO b) -> IO b
withPrimVectorSafe Bytes
buf ((Ptr Word8 -> Int -> IO ()) -> IO ())
-> (Ptr Word8 -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pbuf Int
_ ->
        ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
            ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ZStream
hsc_ptr Int
0)) Ptr ZStream
ps Ptr Word8
pbuf
{-# LINE 343 "Z/Compression/Zlib.hsc" #-}
            ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ZStream
hsc_ptr Int
8)) Ptr ZStream
ps (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
buflen :: CUInt)
{-# LINE 344 "Z/Compression/Zlib.hsc" #-}

set_avail_out :: ForeignPtr ZStream -> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out :: ForeignPtr ZStream
-> MutablePrimArray RealWorld Word8 -> Int -> IO ()
set_avail_out ForeignPtr ZStream
zs MutablePrimArray RealWorld Word8
buf Int
bufSiz = do
    MutablePrimArray RealWorld Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. MutablePrimArray RealWorld a -> (Ptr a -> IO b) -> IO b
withMutablePrimArrayContents MutablePrimArray RealWorld Word8
buf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
pbuf ->
        ForeignPtr ZStream -> (Ptr ZStream -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ZStream
zs ((Ptr ZStream -> IO ()) -> IO ())
-> (Ptr ZStream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ZStream
ps -> do
            ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ZStream
hsc_ptr Int
24)) Ptr ZStream
ps Ptr Word8
pbuf
{-# LINE 350 "Z/Compression/Zlib.hsc" #-}
            ((\Ptr ZStream
hsc_ptr -> Ptr ZStream -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ZStream
hsc_ptr Int
32)) Ptr ZStream
ps (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSiz :: CUInt)
{-# LINE 351 "Z/Compression/Zlib.hsc" #-}