module Streaming.Zip (
decompress
, decompress'
, decompressAll
, compress
, gunzip
, gunzip'
, gzip
, CompressionLevel
, defaultCompression
, noCompression
, bestSpeed
, bestCompression
, compressionLevel
, Z.defaultWindowBits
, windowBits
) where
import Data.Streaming.Zlib as Z
import Control.Exception (throwIO)
import Control.Monad (unless)
import qualified Data.ByteString as B
import Data.ByteString.Streaming hiding (for)
import Streaming
import qualified Data.ByteString.Streaming.Internal as I
import Data.ByteString.Streaming.Internal (ByteString (..))
decompress
:: MonadIO m
=> Z.WindowBits
-> ByteString m r
-> ByteString m r
decompress :: forall (m :: * -> *) r.
MonadIO m =>
WindowBits -> ByteString m r -> ByteString m r
decompress WindowBits
wbits ByteString m r
p0 = do
Inflate
inf <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WindowBits -> IO Inflate
Z.initInflate WindowBits
wbits
r
r <- forall {m :: * -> *} {b} {a}.
Monad m =>
ByteStream m b -> (ByteString -> ByteStream m a) -> ByteStream m b
for ByteString m r
p0 forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do
Popper
popper <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper Popper
popper
ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.finishInflate Inflate
inf
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs)
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE decompress #-}
decompress'
:: MonadIO m
=> Z.WindowBits
-> ByteString m r
-> ByteString m (Either (ByteString m r) r)
decompress' :: forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
wbits ByteString m r
p0 = forall {m :: * -> *} {b}.
MonadIO m =>
ByteStream m b
-> Inflate -> ByteStream m (Either (ByteStream m b) b)
go ByteString m r
p0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WindowBits -> IO Inflate
Z.initInflate WindowBits
wbits)
where
flush :: Inflate -> ByteStream m ()
flush Inflate
inf = do
ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.flushInflate Inflate
inf
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs)
go :: ByteStream m b
-> Inflate -> ByteStream m (Either (ByteStream m b) b)
go ByteStream m b
p Inflate
inf = do
Either b (ByteString, ByteStream m b)
res <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextChunk ByteStream m b
p)
case Either b (ByteString, ByteStream m b)
res of
Left b
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
r
Right (ByteString
bs, ByteStream m b
p') -> do
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
forall {m :: * -> *}. MonadIO m => Inflate -> ByteStream m ()
flush Inflate
inf
ByteString
leftover <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.getUnusedInflate Inflate
inf
if ByteString -> Bool
B.null ByteString
leftover
then ByteStream m b
-> Inflate -> ByteStream m (Either (ByteStream m b) b)
go ByteStream m b
p' Inflate
inf
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
leftover forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m b
p')
{-# INLINABLE decompress' #-}
decompressAll :: MonadIO m => Z.WindowBits -> ByteString m r -> ByteString m r
decompressAll :: forall (m :: * -> *) r.
MonadIO m =>
WindowBits -> ByteString m r -> ByteString m r
decompressAll WindowBits
w ByteString m r
bs = forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
w ByteString m r
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {r}.
MonadIO m =>
Either (ByteString m r) r -> ByteString m r
go
where
go :: Either (ByteString m r) r -> ByteString m r
go (Left ByteString m r
bs) = forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
w ByteString m r
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (ByteString m r) r -> ByteString m r
go
go (Right r
r) = forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE decompressAll #-}
compress
:: MonadIO m
=> CompressionLevel
-> Z.WindowBits
-> ByteString m r
-> ByteString m r
compress :: forall (m :: * -> *) r.
MonadIO m =>
CompressionLevel -> WindowBits -> ByteString m r -> ByteString m r
compress (CompressionLevel Int
clevel) WindowBits
wbits ByteString m r
p0 = do
Deflate
def <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> IO Deflate
Z.initDeflate Int
clevel WindowBits
wbits
let loop :: ByteStream m b -> ByteStream m b
loop ByteStream m b
bs = case ByteStream m b
bs of
I.Chunk ByteString
c ByteStream m b
rest -> do
Popper
popper <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> ByteString -> IO Popper
Z.feedDeflate Deflate
def ByteString
c)
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper Popper
popper
ByteStream m b -> ByteStream m b
loop ByteStream m b
rest
I.Go m (ByteStream m b)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteStream m b -> ByteStream m b
loop m (ByteStream m b)
m)
I.Empty b
r -> forall (m :: * -> *) a. Monad m => a -> m a
return b
r
r
r <- forall {m :: * -> *} {b}.
MonadIO m =>
ByteStream m b -> ByteStream m b
loop ByteString m r
p0
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper forall a b. (a -> b) -> a -> b
$ Deflate -> Popper
Z.finishDeflate Deflate
def
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE compress #-}
newtype CompressionLevel = CompressionLevel Int
deriving (Int -> CompressionLevel -> ShowS
[CompressionLevel] -> ShowS
CompressionLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionLevel] -> ShowS
$cshowList :: [CompressionLevel] -> ShowS
show :: CompressionLevel -> String
$cshow :: CompressionLevel -> String
showsPrec :: Int -> CompressionLevel -> ShowS
$cshowsPrec :: Int -> CompressionLevel -> ShowS
Show, ReadPrec [CompressionLevel]
ReadPrec CompressionLevel
Int -> ReadS CompressionLevel
ReadS [CompressionLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompressionLevel]
$creadListPrec :: ReadPrec [CompressionLevel]
readPrec :: ReadPrec CompressionLevel
$creadPrec :: ReadPrec CompressionLevel
readList :: ReadS [CompressionLevel]
$creadList :: ReadS [CompressionLevel]
readsPrec :: Int -> ReadS CompressionLevel
$creadsPrec :: Int -> ReadS CompressionLevel
Read, CompressionLevel -> CompressionLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionLevel -> CompressionLevel -> Bool
$c/= :: CompressionLevel -> CompressionLevel -> Bool
== :: CompressionLevel -> CompressionLevel -> Bool
$c== :: CompressionLevel -> CompressionLevel -> Bool
Eq, Eq CompressionLevel
CompressionLevel -> CompressionLevel -> Bool
CompressionLevel -> CompressionLevel -> Ordering
CompressionLevel -> CompressionLevel -> CompressionLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmin :: CompressionLevel -> CompressionLevel -> CompressionLevel
max :: CompressionLevel -> CompressionLevel -> CompressionLevel
$cmax :: CompressionLevel -> CompressionLevel -> CompressionLevel
>= :: CompressionLevel -> CompressionLevel -> Bool
$c>= :: CompressionLevel -> CompressionLevel -> Bool
> :: CompressionLevel -> CompressionLevel -> Bool
$c> :: CompressionLevel -> CompressionLevel -> Bool
<= :: CompressionLevel -> CompressionLevel -> Bool
$c<= :: CompressionLevel -> CompressionLevel -> Bool
< :: CompressionLevel -> CompressionLevel -> Bool
$c< :: CompressionLevel -> CompressionLevel -> Bool
compare :: CompressionLevel -> CompressionLevel -> Ordering
$ccompare :: CompressionLevel -> CompressionLevel -> Ordering
Ord)
defaultCompression, noCompression, bestSpeed, bestCompression :: CompressionLevel
defaultCompression :: CompressionLevel
defaultCompression = Int -> CompressionLevel
CompressionLevel (-Int
1)
noCompression :: CompressionLevel
noCompression = Int -> CompressionLevel
CompressionLevel Int
0
bestSpeed :: CompressionLevel
bestSpeed = Int -> CompressionLevel
CompressionLevel Int
1
bestCompression :: CompressionLevel
bestCompression = Int -> CompressionLevel
CompressionLevel Int
9
compressionLevel :: Int -> CompressionLevel
compressionLevel :: Int -> CompressionLevel
compressionLevel Int
n
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CompressionLevel
CompressionLevel Int
n
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"CompressionLevel must be in the range 0..9"
windowBits :: Int -> WindowBits
windowBits :: Int -> WindowBits
windowBits = Int -> WindowBits
WindowBits
gunzip
:: MonadIO m
=> ByteString m r
-> ByteString m r
gunzip :: forall {m :: * -> *} {b}.
MonadIO m =>
ByteStream m b -> ByteStream m b
gunzip = forall (m :: * -> *) r.
MonadIO m =>
WindowBits -> ByteString m r -> ByteString m r
decompress WindowBits
gzWindowBits
{-# INLINABLE gunzip #-}
gunzip'
:: MonadIO m
=> ByteString m r
-> ByteString m (Either (ByteString m r) r)
gunzip' :: forall (m :: * -> *) r.
MonadIO m =>
ByteString m r -> ByteString m (Either (ByteString m r) r)
gunzip' = forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
gzWindowBits
{-# INLINE gunzip' #-}
gzip
:: MonadIO m
=> CompressionLevel
-> ByteString m r
-> ByteString m r
gzip :: forall (m :: * -> *) r.
MonadIO m =>
CompressionLevel -> ByteString m r -> ByteString m r
gzip CompressionLevel
clevel = forall (m :: * -> *) r.
MonadIO m =>
CompressionLevel -> WindowBits -> ByteString m r -> ByteString m r
compress CompressionLevel
clevel WindowBits
gzWindowBits
{-# INLINE gzip #-}
gzWindowBits :: Z.WindowBits
gzWindowBits :: WindowBits
gzWindowBits = Int -> WindowBits
Z.WindowBits Int
31
for :: ByteStream m b -> (ByteString -> ByteStream m a) -> ByteStream m b
for ByteStream m b
bs0 ByteString -> ByteStream m a
op = forall {b}. ByteStream m b -> ByteStream m b
loop ByteStream m b
bs0 where
loop :: ByteStream m b -> ByteStream m b
loop ByteStream m b
bs = case ByteStream m b
bs of
I.Chunk ByteString
c ByteStream m b
rest -> ByteString -> ByteStream m a
op ByteString
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m b -> ByteStream m b
loop ByteStream m b
rest
I.Go m (ByteStream m b)
m -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteStream m b -> ByteStream m b
loop m (ByteStream m b)
m)
I.Empty b
r -> forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# INLINABLE for #-}
fromPopper :: MonadIO m
=> Z.Popper
-> ByteString m ()
fromPopper :: forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper Popper
pop = ByteStream m ()
loop
where
loop :: ByteStream m ()
loop = do
PopperRes
mbs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Popper
pop
case PopperRes
mbs of
PopperRes
PRDone -> forall (m :: * -> *) r. r -> ByteStream m r
I.Empty ()
PRError ZlibException
e -> forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => e -> IO a
throwIO ZlibException
e))
PRNext ByteString
bs -> forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
I.Chunk ByteString
bs ByteStream m ()
loop
{-# INLINABLE fromPopper #-}