{-# LANGUAGE CPP, RankNTypes, DeriveDataTypeable, BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
module Codec.Compression.Zlib.Internal (
compress,
decompress,
CompressStream(..),
compressST,
compressIO,
foldCompressStream,
foldCompressStreamWithInput,
DecompressStream(..),
DecompressError(..),
decompressST,
decompressIO,
foldDecompressStream,
foldDecompressStreamWithInput,
CompressParams(..),
defaultCompressParams,
DecompressParams(..),
defaultDecompressParams,
Stream.Format,
Stream.gzipFormat,
Stream.zlibFormat,
Stream.rawFormat,
Stream.gzipOrZlibFormat,
Stream.CompressionLevel(..),
Stream.defaultCompression,
Stream.noCompression,
Stream.bestSpeed,
Stream.bestCompression,
Stream.compressionLevel,
Stream.Method,
Stream.deflateMethod,
Stream.WindowBits(..),
Stream.defaultWindowBits,
Stream.windowBits,
Stream.MemoryLevel(..),
Stream.defaultMemoryLevel,
Stream.minMemoryLevel,
Stream.maxMemoryLevel,
Stream.memoryLevel,
Stream.CompressionStrategy,
Stream.defaultStrategy,
Stream.filteredStrategy,
Stream.huffmanOnlyStrategy,
Stream.rleStrategy,
Stream.fixedStrategy,
) where
import Prelude hiding (length)
import Control.Monad (when)
import Control.Exception (Exception, throw, assert)
import Control.Monad.ST.Lazy hiding (stToIO)
import Control.Monad.ST.Strict (stToIO)
import qualified Control.Monad.ST.Unsafe as Unsafe (unsafeIOToST)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Data.Bits (toIntegralSized)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S
import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import Foreign.C (CUInt)
import GHC.IO (noDuplicate)
import qualified Codec.Compression.Zlib.Stream as Stream
import Codec.Compression.Zlib.ByteStringCompat (mkBS, withBS)
import Codec.Compression.Zlib.Stream (Stream)
data CompressParams = CompressParams {
CompressParams -> CompressionLevel
compressLevel :: !Stream.CompressionLevel,
CompressParams -> Method
compressMethod :: !Stream.Method,
CompressParams -> WindowBits
compressWindowBits :: !Stream.WindowBits,
CompressParams -> MemoryLevel
compressMemoryLevel :: !Stream.MemoryLevel,
CompressParams -> CompressionStrategy
compressStrategy :: !Stream.CompressionStrategy,
CompressParams -> Int
compressBufferSize :: !Int,
CompressParams -> Maybe ByteString
compressDictionary :: Maybe S.ByteString
} deriving
( CompressParams -> CompressParams -> Bool
(CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> Bool) -> Eq CompressParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressParams -> CompressParams -> Bool
== :: CompressParams -> CompressParams -> Bool
$c/= :: CompressParams -> CompressParams -> Bool
/= :: CompressParams -> CompressParams -> Bool
Eq
, Eq CompressParams
Eq CompressParams =>
(CompressParams -> CompressParams -> Ordering)
-> (CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> Bool)
-> (CompressParams -> CompressParams -> CompressParams)
-> (CompressParams -> CompressParams -> CompressParams)
-> Ord CompressParams
CompressParams -> CompressParams -> Bool
CompressParams -> CompressParams -> Ordering
CompressParams -> CompressParams -> CompressParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompressParams -> CompressParams -> Ordering
compare :: CompressParams -> CompressParams -> Ordering
$c< :: CompressParams -> CompressParams -> Bool
< :: CompressParams -> CompressParams -> Bool
$c<= :: CompressParams -> CompressParams -> Bool
<= :: CompressParams -> CompressParams -> Bool
$c> :: CompressParams -> CompressParams -> Bool
> :: CompressParams -> CompressParams -> Bool
$c>= :: CompressParams -> CompressParams -> Bool
>= :: CompressParams -> CompressParams -> Bool
$cmax :: CompressParams -> CompressParams -> CompressParams
max :: CompressParams -> CompressParams -> CompressParams
$cmin :: CompressParams -> CompressParams -> CompressParams
min :: CompressParams -> CompressParams -> CompressParams
Ord
, Int -> CompressParams -> ShowS
[CompressParams] -> ShowS
CompressParams -> String
(Int -> CompressParams -> ShowS)
-> (CompressParams -> String)
-> ([CompressParams] -> ShowS)
-> Show CompressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressParams -> ShowS
showsPrec :: Int -> CompressParams -> ShowS
$cshow :: CompressParams -> String
show :: CompressParams -> String
$cshowList :: [CompressParams] -> ShowS
showList :: [CompressParams] -> ShowS
Show
, Typeable
, (forall x. CompressParams -> Rep CompressParams x)
-> (forall x. Rep CompressParams x -> CompressParams)
-> Generic CompressParams
forall x. Rep CompressParams x -> CompressParams
forall x. CompressParams -> Rep CompressParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompressParams -> Rep CompressParams x
from :: forall x. CompressParams -> Rep CompressParams x
$cto :: forall x. Rep CompressParams x -> CompressParams
to :: forall x. Rep CompressParams x -> CompressParams
Generic
)
data DecompressParams = DecompressParams {
DecompressParams -> WindowBits
decompressWindowBits :: !Stream.WindowBits,
DecompressParams -> Int
decompressBufferSize :: !Int,
DecompressParams -> Maybe ByteString
decompressDictionary :: Maybe S.ByteString,
DecompressParams -> Bool
decompressAllMembers :: Bool
} deriving
( DecompressParams -> DecompressParams -> Bool
(DecompressParams -> DecompressParams -> Bool)
-> (DecompressParams -> DecompressParams -> Bool)
-> Eq DecompressParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecompressParams -> DecompressParams -> Bool
== :: DecompressParams -> DecompressParams -> Bool
$c/= :: DecompressParams -> DecompressParams -> Bool
/= :: DecompressParams -> DecompressParams -> Bool
Eq
, Eq DecompressParams
Eq DecompressParams =>
(DecompressParams -> DecompressParams -> Ordering)
-> (DecompressParams -> DecompressParams -> Bool)
-> (DecompressParams -> DecompressParams -> Bool)
-> (DecompressParams -> DecompressParams -> Bool)
-> (DecompressParams -> DecompressParams -> Bool)
-> (DecompressParams -> DecompressParams -> DecompressParams)
-> (DecompressParams -> DecompressParams -> DecompressParams)
-> Ord DecompressParams
DecompressParams -> DecompressParams -> Bool
DecompressParams -> DecompressParams -> Ordering
DecompressParams -> DecompressParams -> DecompressParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DecompressParams -> DecompressParams -> Ordering
compare :: DecompressParams -> DecompressParams -> Ordering
$c< :: DecompressParams -> DecompressParams -> Bool
< :: DecompressParams -> DecompressParams -> Bool
$c<= :: DecompressParams -> DecompressParams -> Bool
<= :: DecompressParams -> DecompressParams -> Bool
$c> :: DecompressParams -> DecompressParams -> Bool
> :: DecompressParams -> DecompressParams -> Bool
$c>= :: DecompressParams -> DecompressParams -> Bool
>= :: DecompressParams -> DecompressParams -> Bool
$cmax :: DecompressParams -> DecompressParams -> DecompressParams
max :: DecompressParams -> DecompressParams -> DecompressParams
$cmin :: DecompressParams -> DecompressParams -> DecompressParams
min :: DecompressParams -> DecompressParams -> DecompressParams
Ord
, Int -> DecompressParams -> ShowS
[DecompressParams] -> ShowS
DecompressParams -> String
(Int -> DecompressParams -> ShowS)
-> (DecompressParams -> String)
-> ([DecompressParams] -> ShowS)
-> Show DecompressParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecompressParams -> ShowS
showsPrec :: Int -> DecompressParams -> ShowS
$cshow :: DecompressParams -> String
show :: DecompressParams -> String
$cshowList :: [DecompressParams] -> ShowS
showList :: [DecompressParams] -> ShowS
Show
, Typeable
, (forall x. DecompressParams -> Rep DecompressParams x)
-> (forall x. Rep DecompressParams x -> DecompressParams)
-> Generic DecompressParams
forall x. Rep DecompressParams x -> DecompressParams
forall x. DecompressParams -> Rep DecompressParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecompressParams -> Rep DecompressParams x
from :: forall x. DecompressParams -> Rep DecompressParams x
$cto :: forall x. Rep DecompressParams x -> DecompressParams
to :: forall x. Rep DecompressParams x -> DecompressParams
Generic
)
defaultCompressParams :: CompressParams
defaultCompressParams :: CompressParams
defaultCompressParams = CompressParams {
compressLevel :: CompressionLevel
compressLevel = CompressionLevel
Stream.defaultCompression,
compressMethod :: Method
compressMethod = Method
Stream.deflateMethod,
compressWindowBits :: WindowBits
compressWindowBits = WindowBits
Stream.defaultWindowBits,
compressMemoryLevel :: MemoryLevel
compressMemoryLevel = MemoryLevel
Stream.defaultMemoryLevel,
compressStrategy :: CompressionStrategy
compressStrategy = CompressionStrategy
Stream.defaultStrategy,
compressBufferSize :: Int
compressBufferSize = CUInt -> Int
cuint2int CUInt
defaultCompressBufferSize,
compressDictionary :: Maybe ByteString
compressDictionary = Maybe ByteString
forall a. Maybe a
Nothing
}
defaultDecompressParams :: DecompressParams
defaultDecompressParams :: DecompressParams
defaultDecompressParams = DecompressParams {
decompressWindowBits :: WindowBits
decompressWindowBits = WindowBits
Stream.defaultWindowBits,
decompressBufferSize :: Int
decompressBufferSize = CUInt -> Int
cuint2int CUInt
defaultDecompressBufferSize,
decompressDictionary :: Maybe ByteString
decompressDictionary = Maybe ByteString
forall a. Maybe a
Nothing,
decompressAllMembers :: Bool
decompressAllMembers = Bool
True
}
defaultCompressBufferSize, defaultDecompressBufferSize :: CUInt
defaultCompressBufferSize :: CUInt
defaultCompressBufferSize = CUInt
16 CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
* CUInt
1024 CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
- Int -> CUInt
int2cuint Int
L.chunkOverhead
defaultDecompressBufferSize :: CUInt
defaultDecompressBufferSize = CUInt
32 CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
* CUInt
1024 CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
- Int -> CUInt
int2cuint Int
L.chunkOverhead
data DecompressStream m =
DecompressInputRequired {
forall (m :: * -> *).
DecompressStream m -> ByteString -> m (DecompressStream m)
decompressSupplyInput :: S.ByteString -> m (DecompressStream m)
}
| DecompressOutputAvailable {
forall (m :: * -> *). DecompressStream m -> ByteString
decompressOutput :: !S.ByteString,
forall (m :: * -> *). DecompressStream m -> m (DecompressStream m)
decompressNext :: m (DecompressStream m)
}
| DecompressStreamEnd {
forall (m :: * -> *). DecompressStream m -> ByteString
decompressUnconsumedInput :: S.ByteString
}
| DecompressStreamError {
forall (m :: * -> *). DecompressStream m -> DecompressError
decompressStreamError :: DecompressError
}
data DecompressError =
TruncatedInput
| DictionaryRequired
| DictionaryMismatch
| DataFormatError String
deriving
( DecompressError -> DecompressError -> Bool
(DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> Bool)
-> Eq DecompressError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecompressError -> DecompressError -> Bool
== :: DecompressError -> DecompressError -> Bool
$c/= :: DecompressError -> DecompressError -> Bool
/= :: DecompressError -> DecompressError -> Bool
Eq
, Eq DecompressError
Eq DecompressError =>
(DecompressError -> DecompressError -> Ordering)
-> (DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> Bool)
-> (DecompressError -> DecompressError -> DecompressError)
-> (DecompressError -> DecompressError -> DecompressError)
-> Ord DecompressError
DecompressError -> DecompressError -> Bool
DecompressError -> DecompressError -> Ordering
DecompressError -> DecompressError -> DecompressError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DecompressError -> DecompressError -> Ordering
compare :: DecompressError -> DecompressError -> Ordering
$c< :: DecompressError -> DecompressError -> Bool
< :: DecompressError -> DecompressError -> Bool
$c<= :: DecompressError -> DecompressError -> Bool
<= :: DecompressError -> DecompressError -> Bool
$c> :: DecompressError -> DecompressError -> Bool
> :: DecompressError -> DecompressError -> Bool
$c>= :: DecompressError -> DecompressError -> Bool
>= :: DecompressError -> DecompressError -> Bool
$cmax :: DecompressError -> DecompressError -> DecompressError
max :: DecompressError -> DecompressError -> DecompressError
$cmin :: DecompressError -> DecompressError -> DecompressError
min :: DecompressError -> DecompressError -> DecompressError
Ord
, Typeable
, (forall x. DecompressError -> Rep DecompressError x)
-> (forall x. Rep DecompressError x -> DecompressError)
-> Generic DecompressError
forall x. Rep DecompressError x -> DecompressError
forall x. DecompressError -> Rep DecompressError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecompressError -> Rep DecompressError x
from :: forall x. DecompressError -> Rep DecompressError x
$cto :: forall x. Rep DecompressError x -> DecompressError
to :: forall x. Rep DecompressError x -> DecompressError
Generic
)
instance Show DecompressError where
show :: DecompressError -> String
show DecompressError
TruncatedInput = ShowS
modprefix String
"premature end of compressed data stream"
show DecompressError
DictionaryRequired = ShowS
modprefix String
"compressed data stream requires custom dictionary"
show DecompressError
DictionaryMismatch = ShowS
modprefix String
"given dictionary does not match the expected one"
show (DataFormatError String
detail) = ShowS
modprefix (String
"compressed data stream format error (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
detail String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
modprefix :: ShowS
modprefix :: ShowS
modprefix = (String
"Codec.Compression.Zlib: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
instance Exception DecompressError
foldDecompressStream :: Monad m
=> ((S.ByteString -> m a) -> m a)
-> (S.ByteString -> m a -> m a)
-> (S.ByteString -> m a)
-> (DecompressError -> m a)
-> DecompressStream m -> m a
foldDecompressStream :: forall (m :: * -> *) a.
Monad m =>
((ByteString -> m a) -> m a)
-> (ByteString -> m a -> m a)
-> (ByteString -> m a)
-> (DecompressError -> m a)
-> DecompressStream m
-> m a
foldDecompressStream (ByteString -> m a) -> m a
input ByteString -> m a -> m a
output ByteString -> m a
end DecompressError -> m a
err = DecompressStream m -> m a
fold
where
fold :: DecompressStream m -> m a
fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) =
(ByteString -> m a) -> m a
input (\ByteString
x -> ByteString -> m (DecompressStream m)
next ByteString
x m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream m -> m a
fold)
fold (DecompressOutputAvailable ByteString
outchunk m (DecompressStream m)
next) =
ByteString -> m a -> m a
output ByteString
outchunk (m (DecompressStream m)
next m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream m -> m a
fold)
fold (DecompressStreamEnd ByteString
inchunk) = ByteString -> m a
end ByteString
inchunk
fold (DecompressStreamError DecompressError
derr) = DecompressError -> m a
err DecompressError
derr
foldDecompressStreamWithInput :: (S.ByteString -> a -> a)
-> (L.ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> L.ByteString
-> a
foldDecompressStreamWithInput :: forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
foldDecompressStreamWithInput ByteString -> a -> a
chunk ByteString -> a
end DecompressError -> a
err = \forall s. DecompressStream (ST s)
s ByteString
lbs ->
(forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (DecompressStream (ST s) -> [ByteString] -> ST s a
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> [ByteString] -> m a
fold DecompressStream (ST s)
forall s. DecompressStream (ST s)
s (ByteString -> [ByteString]
toLimitedChunks ByteString
lbs))
where
fold :: DecompressStream m -> [ByteString] -> m a
fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) [] =
ByteString -> m (DecompressStream m)
next ByteString
S.empty m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
strm -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
strm []
fold (DecompressInputRequired ByteString -> m (DecompressStream m)
next) (ByteString
inchunk:[ByteString]
inchunks) =
ByteString -> m (DecompressStream m)
next ByteString
inchunk m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
s -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
s [ByteString]
inchunks
fold (DecompressOutputAvailable ByteString
outchunk m (DecompressStream m)
next) [ByteString]
inchunks = do
r <- m (DecompressStream m)
next m (DecompressStream m) -> (DecompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DecompressStream m
s -> DecompressStream m -> [ByteString] -> m a
fold DecompressStream m
s [ByteString]
inchunks
return $ chunk outchunk r
fold (DecompressStreamEnd ByteString
inchunk) [ByteString]
inchunks =
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
end ([ByteString] -> ByteString
L.fromChunks (ByteString
inchunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
inchunks))
fold (DecompressStreamError DecompressError
derr) [ByteString]
_ =
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ DecompressError -> a
err DecompressError
derr
data CompressStream m =
CompressInputRequired {
forall (m :: * -> *).
CompressStream m -> ByteString -> m (CompressStream m)
compressSupplyInput :: S.ByteString -> m (CompressStream m)
}
| CompressOutputAvailable {
forall (m :: * -> *). CompressStream m -> ByteString
compressOutput :: !S.ByteString,
forall (m :: * -> *). CompressStream m -> m (CompressStream m)
compressNext :: m (CompressStream m)
}
| CompressStreamEnd
foldCompressStream :: Monad m
=> ((S.ByteString -> m a) -> m a)
-> (S.ByteString -> m a -> m a)
-> m a
-> CompressStream m -> m a
foldCompressStream :: forall (m :: * -> *) a.
Monad m =>
((ByteString -> m a) -> m a)
-> (ByteString -> m a -> m a) -> m a -> CompressStream m -> m a
foldCompressStream (ByteString -> m a) -> m a
input ByteString -> m a -> m a
output m a
end = CompressStream m -> m a
fold
where
fold :: CompressStream m -> m a
fold (CompressInputRequired ByteString -> m (CompressStream m)
next) =
(ByteString -> m a) -> m a
input (\ByteString
x -> ByteString -> m (CompressStream m)
next ByteString
x m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream m -> m a
fold)
fold (CompressOutputAvailable ByteString
outchunk m (CompressStream m)
next) =
ByteString -> m a -> m a
output ByteString
outchunk (m (CompressStream m)
next m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream m -> m a
fold)
fold CompressStream m
CompressStreamEnd =
m a
end
foldCompressStreamWithInput :: (S.ByteString -> a -> a)
-> a
-> (forall s. CompressStream (ST s))
-> L.ByteString
-> a
foldCompressStreamWithInput :: forall a.
(ByteString -> a -> a)
-> a -> (forall s. CompressStream (ST s)) -> ByteString -> a
foldCompressStreamWithInput ByteString -> a -> a
chunk a
end = \forall s. CompressStream (ST s)
s ByteString
lbs ->
(forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (CompressStream (ST s) -> [ByteString] -> ST s a
forall {m :: * -> *}.
Monad m =>
CompressStream m -> [ByteString] -> m a
fold CompressStream (ST s)
forall s. CompressStream (ST s)
s (ByteString -> [ByteString]
toLimitedChunks ByteString
lbs))
where
fold :: CompressStream m -> [ByteString] -> m a
fold (CompressInputRequired ByteString -> m (CompressStream m)
next) [] =
ByteString -> m (CompressStream m)
next ByteString
S.empty m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
strm -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
strm []
fold (CompressInputRequired ByteString -> m (CompressStream m)
next) (ByteString
inchunk:[ByteString]
inchunks) =
ByteString -> m (CompressStream m)
next ByteString
inchunk m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
s -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
s [ByteString]
inchunks
fold (CompressOutputAvailable ByteString
outchunk m (CompressStream m)
next) [ByteString]
inchunks = do
r <- m (CompressStream m)
next m (CompressStream m) -> (CompressStream m -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CompressStream m
s -> CompressStream m -> [ByteString] -> m a
fold CompressStream m
s [ByteString]
inchunks
return $ chunk outchunk r
fold CompressStream m
CompressStreamEnd [ByteString]
_inchunks =
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
end
compress :: Stream.Format -> CompressParams -> L.ByteString -> L.ByteString
compressST :: Stream.Format -> CompressParams -> CompressStream (ST s)
compressIO :: Stream.Format -> CompressParams -> CompressStream IO
compress :: Format -> CompressParams -> ByteString -> ByteString
compress Format
format CompressParams
params = (ByteString -> ByteString -> ByteString)
-> ByteString
-> (forall s. CompressStream (ST s))
-> ByteString
-> ByteString
forall a.
(ByteString -> a -> a)
-> a -> (forall s. CompressStream (ST s)) -> ByteString -> a
foldCompressStreamWithInput
ByteString -> ByteString -> ByteString
L.Chunk ByteString
L.Empty
(Format -> CompressParams -> CompressStream (ST s)
forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST Format
format CompressParams
params)
compressST :: forall s. Format -> CompressParams -> CompressStream (ST s)
compressST Format
format CompressParams
params = Format -> CompressParams -> CompressStream (ST s)
forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST Format
format CompressParams
params
compressIO :: Format -> CompressParams -> CompressStream IO
compressIO Format
format CompressParams
params = Format -> CompressParams -> CompressStream IO
compressStreamIO Format
format CompressParams
params
compressStream :: Stream.Format -> CompressParams -> S.ByteString
-> Stream (CompressStream Stream)
compressStream :: Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format (CompressParams CompressionLevel
compLevel Method
method WindowBits
bits MemoryLevel
memLevel
CompressionStrategy
strategy Int
initChunkSize Maybe ByteString
mdict) =
\ByteString
chunk -> do
Format
-> CompressionLevel
-> Method
-> WindowBits
-> MemoryLevel
-> CompressionStrategy
-> Stream ()
Stream.deflateInit Format
format CompressionLevel
compLevel Method
method WindowBits
bits MemoryLevel
memLevel CompressionStrategy
strategy
Maybe ByteString -> Stream ()
setDictionary Maybe ByteString
mdict
ByteString
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk ((ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (CompressStream Stream))
-> Stream (CompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then CUInt -> Stream (CompressStream Stream)
fillBuffers CUInt
20
else do
ForeignPtr Word8 -> Int -> CUInt -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 (Int -> CUInt
int2cuint Int
length)
CUInt -> Stream (CompressStream Stream)
fillBuffers (Int -> CUInt
int2cuint_capped Int
initChunkSize)
where
fillBuffers :: CUInt -> Stream (CompressStream Stream)
fillBuffers :: CUInt -> Stream (CompressStream Stream)
fillBuffers CUInt
outChunkSize = do
#ifdef DEBUG
Stream.consistencyCheck
#endif
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
outputBufferFull <- Stream.outputBufferFull
assert (inputBufferEmpty || outputBufferFull) $ return ()
when outputBufferFull $ do
outFPtr <- Stream.unsafeLiftIO (S.mallocByteString (cuint2int outChunkSize))
Stream.pushOutputBuffer outFPtr 0 outChunkSize
if inputBufferEmpty
then return $ CompressInputRequired $ flip withBS $ \ForeignPtr Word8
inFPtr Int
length ->
if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Bool -> Stream (CompressStream Stream)
drainBuffers Bool
True
else do
ForeignPtr Word8 -> Int -> CUInt -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 (Int -> CUInt
int2cuint Int
length)
Bool -> Stream (CompressStream Stream)
drainBuffers Bool
False
else drainBuffers False
drainBuffers :: Bool -> Stream (CompressStream Stream)
drainBuffers :: Bool -> Stream (CompressStream Stream)
drainBuffers Bool
lastChunk = do
inputBufferEmpty' <- Stream Bool
Stream.inputBufferEmpty
outputBufferFull' <- Stream.outputBufferFull
assert(not outputBufferFull'
&& (lastChunk || not inputBufferEmpty')) $ return ()
let flush = if Bool
lastChunk then Flush
Stream.Finish else Flush
Stream.NoFlush
status <- Stream.deflate flush
case status of
Status
Stream.Ok -> do
outputBufferFull <- Stream Bool
Stream.outputBufferFull
if outputBufferFull
then do (outFPtr, offset, length) <- Stream.popOutputBuffer
let chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
return $ CompressOutputAvailable chunk $ do
fillBuffers defaultCompressBufferSize
else do fillBuffers defaultCompressBufferSize
Status
Stream.StreamEnd -> do
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
assert inputBufferEmpty $ return ()
outputBufferBytesAvailable <- Stream.outputBufferBytesAvailable
if outputBufferBytesAvailable > 0
then do (outFPtr, offset, length) <- Stream.popOutputBuffer
let chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
Stream.finalise
return $ CompressOutputAvailable chunk (return CompressStreamEnd)
else do Stream.finalise
return CompressStreamEnd
Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
ErrorCode
Stream.BufferError -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"BufferError should be impossible!"
Stream.NeedDict DictionaryHash
_ -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"NeedDict is impossible!"
ErrorCode
_ -> String -> Stream (CompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
setDictionary :: Maybe S.ByteString -> Stream ()
setDictionary :: Maybe ByteString -> Stream ()
setDictionary (Just ByteString
dict)
| Format -> Bool
Stream.formatSupportsDictionary Format
format = case Int -> Maybe CUInt
int2cuint_safe (ByteString -> Int
S.length ByteString
dict) of
Maybe CUInt
Nothing ->
String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting deflate dictionary, its length does not fit into CUInt"
Just{} -> do
status <- ByteString -> Stream Status
Stream.deflateSetDictionary ByteString
dict
case status of
Status
Stream.Ok -> () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Stream.Error ErrorCode
_ String
msg -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
Status
_ -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting deflate dictionary"
setDictionary Maybe ByteString
_ = () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decompress :: Stream.Format -> DecompressParams -> L.ByteString -> L.ByteString
decompressST :: Stream.Format -> DecompressParams -> DecompressStream (ST s)
decompressIO :: Stream.Format -> DecompressParams -> DecompressStream IO
decompress :: Format -> DecompressParams -> ByteString -> ByteString
decompress Format
format DecompressParams
params = (ByteString -> ByteString -> ByteString)
-> (ByteString -> ByteString)
-> (DecompressError -> ByteString)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> ByteString
forall a.
(ByteString -> a -> a)
-> (ByteString -> a)
-> (DecompressError -> a)
-> (forall s. DecompressStream (ST s))
-> ByteString
-> a
foldDecompressStreamWithInput
ByteString -> ByteString -> ByteString
L.Chunk (ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
L.Empty) DecompressError -> ByteString
forall a e. (HasCallStack, Exception e) => e -> a
throw
(Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST Format
format DecompressParams
params)
decompressST :: forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressST Format
format DecompressParams
params = Format -> DecompressParams -> DecompressStream (ST s)
forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST Format
format DecompressParams
params
decompressIO :: Format -> DecompressParams -> DecompressStream IO
decompressIO Format
format DecompressParams
params = Format -> DecompressParams -> DecompressStream IO
decompressStreamIO Format
format DecompressParams
params
decompressStream :: Stream.Format -> DecompressParams
-> Bool -> S.ByteString
-> Stream (DecompressStream Stream)
decompressStream :: Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format (DecompressParams WindowBits
bits Int
initChunkSize Maybe ByteString
mdict Bool
allMembers)
Bool
resume =
\ByteString
chunk -> do
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
outputBufferFull <- Stream.outputBufferFull
assert inputBufferEmpty $
if resume then assert (format == Stream.gzipFormat && allMembers) $
Stream.inflateReset
else assert outputBufferFull $
Stream.inflateInit format bits
withBS chunk $ \ForeignPtr Word8
inFPtr Int
length ->
if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then do
Bool -> Stream () -> Stream ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
outputBufferFull (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ do
outFPtr <- IO (ForeignPtr Word8) -> Stream (ForeignPtr Word8)
forall a. IO a -> Stream a
Stream.unsafeLiftIO (Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
S.mallocByteString Int
1)
Stream.pushOutputBuffer outFPtr 0 1
Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
True
else do
ForeignPtr Word8 -> Int -> CUInt -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 (Int -> CUInt
int2cuint Int
length)
Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (if Bool -> Bool
not Bool
resume then Bool
outputBufferFull else Bool
True) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
if Bool
outputBufferFull
then CUInt -> Stream (DecompressStream Stream)
fillBuffers (Int -> CUInt
int2cuint_capped Int
initChunkSize)
else Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
False
where
fillBuffers :: CUInt
-> Stream (DecompressStream Stream)
fillBuffers :: CUInt -> Stream (DecompressStream Stream)
fillBuffers CUInt
outChunkSize = do
#ifdef DEBUG
Stream.consistencyCheck
#endif
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
outputBufferFull <- Stream.outputBufferFull
assert (inputBufferEmpty || outputBufferFull) $ return ()
when outputBufferFull $ do
outFPtr <- Stream.unsafeLiftIO (S.mallocByteString (cuint2int outChunkSize))
Stream.pushOutputBuffer outFPtr 0 outChunkSize
if inputBufferEmpty
then return $ DecompressInputRequired $ \ByteString
chunk ->
ByteString
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall r. ByteString -> (ForeignPtr Word8 -> Int -> r) -> r
withBS ByteString
chunk ((ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream))
-> (ForeignPtr Word8 -> Int -> Stream (DecompressStream Stream))
-> Stream (DecompressStream Stream)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
inFPtr Int
length ->
if Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
True
else do
ForeignPtr Word8 -> Int -> CUInt -> Stream ()
Stream.pushInputBuffer ForeignPtr Word8
inFPtr Int
0 (Int -> CUInt
int2cuint Int
length)
Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
False
else drainBuffers False
drainBuffers :: Bool -> Stream (DecompressStream Stream)
drainBuffers :: Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
lastChunk = do
inputBufferEmpty' <- Stream Bool
Stream.inputBufferEmpty
outputBufferFull' <- Stream.outputBufferFull
assert(not outputBufferFull'
&& (lastChunk || not inputBufferEmpty')) $ return ()
status <- Stream.inflate Stream.NoFlush
case status of
Status
Stream.Ok -> do
outputBufferFull <- Stream Bool
Stream.outputBufferFull
if outputBufferFull
then do (outFPtr, offset, length) <- Stream.popOutputBuffer
let chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
outFPtr Int
offset Int
length
return $ DecompressOutputAvailable chunk $ do
fillBuffers defaultDecompressBufferSize
else do fillBuffers defaultDecompressBufferSize
Status
Stream.StreamEnd -> do
inputBufferEmpty <- Stream Bool
Stream.inputBufferEmpty
if inputBufferEmpty
then do finish (DecompressStreamEnd S.empty)
else do (inFPtr, offset, length) <- Stream.popRemainingInputBuffer
let inchunk = ForeignPtr Word8 -> Int -> Int -> ByteString
mkBS ForeignPtr Word8
inFPtr Int
offset Int
length
finish (DecompressStreamEnd inchunk)
Stream.Error ErrorCode
code String
msg -> case ErrorCode
code of
ErrorCode
Stream.BufferError -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
TruncatedInput)
Stream.NeedDict DictionaryHash
adler -> do
err <- DictionaryHash
-> Maybe ByteString -> Stream (Maybe (DecompressStream Stream))
setDictionary DictionaryHash
adler Maybe ByteString
mdict
case err of
Just DecompressStream Stream
streamErr -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish DecompressStream Stream
streamErr
Maybe (DecompressStream Stream)
Nothing -> Bool -> Stream (DecompressStream Stream)
drainBuffers Bool
lastChunk
ErrorCode
Stream.DataError -> DecompressStream Stream -> Stream (DecompressStream Stream)
forall {m :: * -> *}.
Monad m =>
DecompressStream m -> Stream (DecompressStream m)
finish (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError (String -> DecompressError
DataFormatError String
msg))
ErrorCode
_ -> String -> Stream (DecompressStream Stream)
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
finish :: DecompressStream m -> Stream (DecompressStream m)
finish DecompressStream m
end = do
outputBufferBytesAvailable <- Stream Int
Stream.outputBufferBytesAvailable
if outputBufferBytesAvailable > 0
then do (outFPtr, offset, length) <- Stream.popOutputBuffer
return (DecompressOutputAvailable (mkBS outFPtr offset length) (return end))
else return end
setDictionary :: Stream.DictionaryHash -> Maybe S.ByteString
-> Stream (Maybe (DecompressStream Stream))
setDictionary :: DictionaryHash
-> Maybe ByteString -> Stream (Maybe (DecompressStream Stream))
setDictionary DictionaryHash
_adler Maybe ByteString
Nothing =
Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream)))
-> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a b. (a -> b) -> a -> b
$ DecompressStream Stream -> Maybe (DecompressStream Stream)
forall a. a -> Maybe a
Just (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
DictionaryRequired)
setDictionary DictionaryHash
_adler (Just ByteString
dict) = case Int -> Maybe CUInt
int2cuint_safe (ByteString -> Int
S.length ByteString
dict) of
Maybe CUInt
Nothing ->
String -> Stream (Maybe (DecompressStream Stream))
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting inflate dictionary, its length does not fit into CUInt"
Just{} -> do
status <- ByteString -> Stream Status
Stream.inflateSetDictionary ByteString
dict
case status of
Status
Stream.Ok -> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DecompressStream Stream)
forall a. Maybe a
Nothing
Stream.Error ErrorCode
Stream.DataError String
_ ->
Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream)))
-> Maybe (DecompressStream Stream)
-> Stream (Maybe (DecompressStream Stream))
forall a b. (a -> b) -> a -> b
$ DecompressStream Stream -> Maybe (DecompressStream Stream)
forall a. a -> Maybe a
Just (DecompressError -> DecompressStream Stream
forall (m :: * -> *). DecompressError -> DecompressStream m
DecompressStreamError DecompressError
DictionaryMismatch)
Status
_ -> String -> Stream (Maybe (DecompressStream Stream))
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"error when setting inflate dictionary"
mkStateST :: ST s (Stream.State s)
mkStateIO :: IO (Stream.State RealWorld)
mkStateST :: forall s. ST s (State s)
mkStateST = ST s (State s) -> ST s (State s)
forall s a. ST s a -> ST s a
strictToLazyST ST s (State s)
forall s. ST s (State s)
Stream.mkState
mkStateIO :: IO (State RealWorld)
mkStateIO = ST RealWorld (State RealWorld) -> IO (State RealWorld)
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (State RealWorld)
forall s. ST s (State s)
Stream.mkState
runStreamST :: Stream a -> Stream.State s -> ST s (a, Stream.State s)
runStreamIO :: Stream a -> Stream.State RealWorld -> IO (a, Stream.State RealWorld)
runStreamST :: forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream a
strm State s
zstate = ST s (a, State s) -> ST s (a, State s)
forall s a. ST s a -> ST s a
strictToLazyST (IO () -> ST s ()
forall a s. IO a -> ST s a
Unsafe.unsafeIOToST IO ()
noDuplicate ST s () -> ST s (a, State s) -> ST s (a, State s)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream a -> State s -> ST s (a, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
Stream.runStream Stream a
strm State s
zstate)
runStreamIO :: forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream a
strm State RealWorld
zstate = ST RealWorld (a, State RealWorld) -> IO (a, State RealWorld)
forall a. ST RealWorld a -> IO a
stToIO (Stream a -> State RealWorld -> ST RealWorld (a, State RealWorld)
forall a s. Stream a -> State s -> ST s (a, State s)
Stream.runStream Stream a
strm State RealWorld
zstate)
compressStreamIO :: Stream.Format -> CompressParams -> CompressStream IO
compressStreamIO :: Format -> CompressParams -> CompressStream IO
compressStreamIO Format
format CompressParams
params =
CompressInputRequired {
compressSupplyInput :: ByteString -> IO (CompressStream IO)
compressSupplyInput = \ByteString
chunk -> do
zstate <- IO (State RealWorld)
mkStateIO
let next = Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format CompressParams
params
(strm', zstate') <- runStreamIO (next chunk) zstate
return (go strm' zstate')
}
where
go :: CompressStream Stream -> Stream.State RealWorld -> CompressStream IO
go :: CompressStream Stream -> State RealWorld -> CompressStream IO
go (CompressInputRequired ByteString -> Stream (CompressStream Stream)
next) State RealWorld
zstate =
CompressInputRequired {
compressSupplyInput :: ByteString -> IO (CompressStream IO)
compressSupplyInput = \ByteString
chunk -> do
(strm', zstate') <- Stream (CompressStream Stream)
-> State RealWorld -> IO (CompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
return (go strm' zstate')
}
go (CompressOutputAvailable ByteString
chunk Stream (CompressStream Stream)
next) State RealWorld
zstate =
ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (IO (CompressStream IO) -> CompressStream IO)
-> IO (CompressStream IO) -> CompressStream IO
forall a b. (a -> b) -> a -> b
$ do
(strm', zstate') <- Stream (CompressStream Stream)
-> State RealWorld -> IO (CompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (CompressStream Stream)
next State RealWorld
zstate
return (go strm' zstate')
go CompressStream Stream
CompressStreamEnd State RealWorld
_ = CompressStream IO
forall (m :: * -> *). CompressStream m
CompressStreamEnd
compressStreamST :: Stream.Format -> CompressParams -> CompressStream (ST s)
compressStreamST :: forall s. Format -> CompressParams -> CompressStream (ST s)
compressStreamST Format
format CompressParams
params =
CompressInputRequired {
compressSupplyInput :: ByteString -> ST s (CompressStream (ST s))
compressSupplyInput = \ByteString
chunk -> do
zstate <- ST s (State s)
forall s. ST s (State s)
mkStateST
let next = Format
-> CompressParams -> ByteString -> Stream (CompressStream Stream)
compressStream Format
format CompressParams
params
(strm', zstate') <- runStreamST (next chunk) zstate
return (go strm' zstate')
}
where
go :: CompressStream Stream -> Stream.State s -> CompressStream (ST s)
go :: forall s. CompressStream Stream -> State s -> CompressStream (ST s)
go (CompressInputRequired ByteString -> Stream (CompressStream Stream)
next) State s
zstate =
CompressInputRequired {
compressSupplyInput :: ByteString -> ST s (CompressStream (ST s))
compressSupplyInput = \ByteString
chunk -> do
(strm', zstate') <- Stream (CompressStream Stream)
-> State s -> ST s (CompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (CompressStream Stream)
next ByteString
chunk) State s
zstate
return (go strm' zstate')
}
go (CompressOutputAvailable ByteString
chunk Stream (CompressStream Stream)
next) State s
zstate =
ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
chunk (ST s (CompressStream (ST s)) -> CompressStream (ST s))
-> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ do
(strm', zstate') <- Stream (CompressStream Stream)
-> State s -> ST s (CompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (CompressStream Stream)
next State s
zstate
return (go strm' zstate')
go CompressStream Stream
CompressStreamEnd State s
_ = CompressStream (ST s)
forall (m :: * -> *). CompressStream m
CompressStreamEnd
decompressStreamIO :: Stream.Format -> DecompressParams -> DecompressStream IO
decompressStreamIO :: Format -> DecompressParams -> DecompressStream IO
decompressStreamIO Format
format DecompressParams
params =
(ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
zstate <- IO (State RealWorld)
mkStateIO
let next = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
False
(strm', zstate') <- runStreamIO (next chunk) zstate
go strm' zstate' (S.null chunk)
where
go :: DecompressStream Stream -> Stream.State RealWorld -> Bool
-> IO (DecompressStream IO)
go :: DecompressStream Stream
-> State RealWorld -> Bool -> IO (DecompressStream IO)
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State RealWorld
zstate !Bool
_ =
DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
(strm', zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State RealWorld
zstate
go strm' zstate' (S.null chunk)
go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State RealWorld
zstate !Bool
eof =
DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk (IO (DecompressStream IO) -> DecompressStream IO)
-> IO (DecompressStream IO) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ do
(strm', zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
next State RealWorld
zstate
go strm' zstate' eof
go (DecompressStreamEnd ByteString
unconsumed) State RealWorld
zstate !Bool
eof
| Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat
, DecompressParams -> Bool
decompressAllMembers DecompressParams
params
, Bool -> Bool
not Bool
eof = ByteString -> State RealWorld -> IO (DecompressStream IO)
tryFollowingStream ByteString
unconsumed State RealWorld
zstate
| Bool
otherwise = ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State RealWorld
zstate
go (DecompressStreamError DecompressError
err) State RealWorld
zstate !Bool
_ = DecompressError -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err State RealWorld
zstate
tryFollowingStream :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
tryFollowingStream :: ByteString -> State RealWorld -> IO (DecompressStream IO)
tryFollowingStream ByteString
chunk State RealWorld
zstate = case ByteString -> Int
S.length ByteString
chunk of
Int
0 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
Int
0 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State RealWorld
zstate
Int
1 | HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
-> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State RealWorld
zstate
Int
1 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
Int
0 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State RealWorld
zstate
Int
_ -> Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit (HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk') ByteString
chunk'' State RealWorld
zstate
Int
_ -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk' State RealWorld
zstate
Int
1 -> DecompressStream IO -> IO (DecompressStream IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> IO (DecompressStream IO)) -> DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
Int
0 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk State RealWorld
zstate
Int
_ -> Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit (HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk) ByteString
chunk' State RealWorld
zstate
Int
_ -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk State RealWorld
zstate
checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit :: Word8 -> ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeaderSplit Word8
0x1f ByteString
chunk State RealWorld
zstate
| HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ([Word8] -> ByteString
S.pack [Word8
0x1f, Word8
0x8b])
if ByteString -> Int
S.length ByteString
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then do
(DecompressInputRequired next, zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
(strm', zstate'') <- runStreamIO (next (S.tail chunk)) zstate'
go strm' zstate'' False
else do
(strm, zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
go strm zstate' False
checkHeaderSplit Word8
byte ByteString
chunk State RealWorld
zstate =
ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd (Word8 -> ByteString -> ByteString
S.cons Word8
byte ByteString
chunk) State RealWorld
zstate
checkHeader :: S.ByteString -> Stream.State RealWorld -> IO (DecompressStream IO)
checkHeader :: ByteString -> State RealWorld -> IO (DecompressStream IO)
checkHeader ByteString
chunk State RealWorld
zstate
| HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x1f
, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ByteString
chunk
(strm', zstate') <- Stream (DecompressStream Stream)
-> State RealWorld -> IO (DecompressStream Stream, State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream (DecompressStream Stream)
resume State RealWorld
zstate
go strm' zstate' False
checkHeader ByteString
chunk State RealWorld
zstate = ByteString -> State RealWorld -> IO (DecompressStream IO)
forall {m :: * -> *}.
ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
chunk State RealWorld
zstate
finaliseStreamEnd :: ByteString -> State RealWorld -> IO (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State RealWorld
zstate = do
_ <- Stream () -> State RealWorld -> IO ((), State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
return (DecompressStreamEnd unconsumed)
finaliseStreamError :: DecompressError -> State RealWorld -> IO (DecompressStream m)
finaliseStreamError DecompressError
err State RealWorld
zstate = do
_ <- Stream () -> State RealWorld -> IO ((), State RealWorld)
forall a. Stream a -> State RealWorld -> IO (a, State RealWorld)
runStreamIO Stream ()
Stream.finalise State RealWorld
zstate
return (DecompressStreamError err)
decompressStreamST :: Stream.Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST :: forall s. Format -> DecompressParams -> DecompressStream (ST s)
decompressStreamST Format
format DecompressParams
params =
(ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
zstate <- ST s (State s)
forall s. ST s (State s)
mkStateST
let next = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
False
(strm', zstate') <- runStreamST (next chunk) zstate
go strm' zstate' (S.null chunk)
where
go :: DecompressStream Stream -> Stream.State s -> Bool
-> ST s (DecompressStream (ST s))
go :: forall s.
DecompressStream Stream
-> State s -> Bool -> ST s (DecompressStream (ST s))
go (DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
next) State s
zstate !Bool
_ =
DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk -> do
(strm', zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST (ByteString -> Stream (DecompressStream Stream)
next ByteString
chunk) State s
zstate
go strm' zstate' (S.null chunk)
go (DecompressOutputAvailable ByteString
chunk Stream (DecompressStream Stream)
next) State s
zstate !Bool
eof =
DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
chunk (ST s (DecompressStream (ST s)) -> DecompressStream (ST s))
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ do
(strm', zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
next State s
zstate
go strm' zstate' eof
go (DecompressStreamEnd ByteString
unconsumed) State s
zstate !Bool
eof
| Format
format Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
Stream.gzipFormat
, DecompressParams -> Bool
decompressAllMembers DecompressParams
params
, Bool -> Bool
not Bool
eof = ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
tryFollowingStream ByteString
unconsumed State s
zstate
| Bool
otherwise = ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State s
zstate
go (DecompressStreamError DecompressError
err) State s
zstate !Bool
_ = DecompressError -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
DecompressError -> State s -> ST s (DecompressStream m)
finaliseStreamError DecompressError
err State s
zstate
tryFollowingStream :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
tryFollowingStream :: forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
tryFollowingStream ByteString
chunk State s
zstate =
case ByteString -> Int
S.length ByteString
chunk of
Int
0 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
Int
0 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
S.empty State s
zstate
Int
1 | HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x1f
-> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
Int
1 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk'' -> case ByteString -> Int
S.length ByteString
chunk'' of
Int
0 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk' State s
zstate
Int
_ -> Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit (HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk') ByteString
chunk'' State s
zstate
Int
_ -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk' State s
zstate
Int
1 -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ((ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall a b. (a -> b) -> a -> b
$ \ByteString
chunk' -> case ByteString -> Int
S.length ByteString
chunk' of
Int
0 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk State s
zstate
Int
_ -> Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit (HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk) ByteString
chunk' State s
zstate
Int
_ -> ByteString -> State s -> ST s (DecompressStream (ST s))
forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk State s
zstate
checkHeaderSplit :: Word8 -> S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
checkHeaderSplit :: forall s.
Word8 -> ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeaderSplit Word8
0x1f ByteString
chunk State s
zstate
| HasCallStack => ByteString -> Word8
ByteString -> Word8
S.head ByteString
chunk Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ([Word8] -> ByteString
S.pack [Word8
0x1f, Word8
0x8b])
if ByteString -> Int
S.length ByteString
chunk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then do
(x, zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
let next = case DecompressStream Stream
x of
DecompressInputRequired ByteString -> Stream (DecompressStream Stream)
n -> ByteString -> Stream (DecompressStream Stream)
n
DecompressStream Stream
_ -> String -> ByteString -> Stream (DecompressStream Stream)
forall a. HasCallStack => String -> a
error String
"checkHeaderSplit: unexpected result of runStreamST"
(strm', zstate'') <- runStreamST (next (S.tail chunk)) zstate'
go strm' zstate'' False
else do
(strm, zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
go strm zstate' False
checkHeaderSplit Word8
byte ByteString
chunk State s
zstate =
ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd (Word8 -> ByteString -> ByteString
S.cons Word8
byte ByteString
chunk) State s
zstate
checkHeader :: S.ByteString -> Stream.State s -> ST s (DecompressStream (ST s))
checkHeader :: forall s. ByteString -> State s -> ST s (DecompressStream (ST s))
checkHeader ByteString
chunk State s
zstate
| HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x1f
, HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
S.index ByteString
chunk Int
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x8b = do
let resume :: Stream (DecompressStream Stream)
resume = Format
-> DecompressParams
-> Bool
-> ByteString
-> Stream (DecompressStream Stream)
decompressStream Format
format DecompressParams
params Bool
True ByteString
chunk
(strm', zstate') <- Stream (DecompressStream Stream)
-> State s -> ST s (DecompressStream Stream, State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream (DecompressStream Stream)
resume State s
zstate
go strm' zstate' False
checkHeader ByteString
chunk State s
zstate = ByteString -> State s -> ST s (DecompressStream (ST s))
forall {s} {m :: * -> *}.
ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
chunk State s
zstate
finaliseStreamEnd :: ByteString -> State s -> ST s (DecompressStream m)
finaliseStreamEnd ByteString
unconsumed State s
zstate = do
_ <- Stream () -> State s -> ST s ((), State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
return (DecompressStreamEnd unconsumed)
finaliseStreamError :: DecompressError -> State s -> ST s (DecompressStream m)
finaliseStreamError DecompressError
err State s
zstate = do
_ <- Stream () -> State s -> ST s ((), State s)
forall a s. Stream a -> State s -> ST s (a, State s)
runStreamST Stream ()
Stream.finalise State s
zstate
return (DecompressStreamError err)
cuint2int :: CUInt -> Int
cuint2int :: CUInt -> Int
cuint2int CUInt
n = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"cuint2int: cannot cast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CUInt -> String
forall a. Show a => a -> String
show CUInt
n) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ CUInt -> Maybe Int
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized CUInt
n
int2cuint :: Int -> CUInt
int2cuint :: Int -> CUInt
int2cuint Int
n = CUInt -> Maybe CUInt -> CUInt
forall a. a -> Maybe a -> a
fromMaybe (String -> CUInt
forall a. HasCallStack => String -> a
error (String -> CUInt) -> String -> CUInt
forall a b. (a -> b) -> a -> b
$ String
"int2cuint: cannot cast " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) (Maybe CUInt -> CUInt) -> Maybe CUInt -> CUInt
forall a b. (a -> b) -> a -> b
$ Int -> Maybe CUInt
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized Int
n
int2cuint_capped :: Int -> CUInt
int2cuint_capped :: Int -> CUInt
int2cuint_capped = CUInt -> Maybe CUInt -> CUInt
forall a. a -> Maybe a -> a
fromMaybe CUInt
forall a. Bounded a => a
maxBound (Maybe CUInt -> CUInt) -> (Int -> Maybe CUInt) -> Int -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe CUInt
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized (Int -> Maybe CUInt) -> (Int -> Int) -> Int -> Maybe CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0
int2cuint_safe :: Int -> Maybe CUInt
int2cuint_safe :: Int -> Maybe CUInt
int2cuint_safe = Int -> Maybe CUInt
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized
toLimitedChunks :: L.ByteString -> [S.ByteString]
toLimitedChunks :: ByteString -> [ByteString]
toLimitedChunks ByteString
L.Empty = []
toLimitedChunks (L.Chunk ByteString
x ByteString
xs) = case Int -> Maybe CUInt
int2cuint_safe (ByteString -> Int
S.length ByteString
x) of
Maybe CUInt
Nothing -> let (ByteString
y, ByteString
z) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (CUInt -> Int
cuint2int (CUInt
forall a. Bounded a => a
maxBound :: CUInt)) ByteString
x in
ByteString
y ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
toLimitedChunks (ByteString -> ByteString -> ByteString
L.Chunk ByteString
z ByteString
xs)
Just{} -> ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
toLimitedChunks ByteString
xs