{-# 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(
CompressConfig(..)
, defaultCompressConfig
, compress
, compressSink
, Strategy (Z_FILTERED, Z_HUFFMAN_ONLY, Z_RLE, Z_FIXED, Z_DEFAULT_STRATEGY)
, CompressLevel(Z_BEST_SPEED, Z_BEST_COMPRESSION, Z_DEFAULT_COMPRESSION)
, WindowBits
, defaultWindowBits
, MemLevel
, defaultMemLevel
, 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 Z_FILTERED :: Strategy
pattern Z_HUFFMAN_ONLY :: Strategy
pattern Z_RLE :: Strategy
pattern Z_FIXED :: Strategy
pattern Z_DEFAULT_STRATEGY :: Strategy
pattern $bZ_FILTERED :: Strategy
$mZ_FILTERED :: forall r. Strategy -> (Void# -> r) -> (Void# -> r) -> r
Z_FILTERED = Strategy (1)
{-# LINE 66 "Z/Compression/Zlib.hsc" #-}
pattern Z_HUFFMAN_ONLY = Strategy (2)
{-# LINE 67 "Z/Compression/Zlib.hsc" #-}
pattern Z_RLE = Strategy (3)
{-# LINE 68 "Z/Compression/Zlib.hsc" #-}
pattern Z_FIXED = Strategy (4)
{-# LINE 69 "Z/Compression/Zlib.hsc" #-}
pattern Z_DEFAULT_STRATEGY = Strategy (0)
{-# LINE 70 "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_BEST_SPEED :: CompressLevel
pattern Z_BEST_COMPRESSION :: CompressLevel
pattern Z_DEFAULT_COMPRESSION :: CompressLevel
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" #-}
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
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
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 :: 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
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
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 :: 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
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 340 "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 341 "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 347 "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 348 "Z/Compression/Zlib.hsc" #-}