-- | This module modifies material in Renzo Carbonara\'s <http://hackage.haskell.org/package/pipes-zlib pipes-zlib> package.   

module Streaming.Zip (
    -- * Streams
      decompress
    , decompress'
    , decompressAll
    , compress
    , gunzip
    , gunzip'
    , gzip 

    -- * Compression levels
    , CompressionLevel
    , defaultCompression
    , noCompression
    , bestSpeed
    , bestCompression
    , compressionLevel

    -- * Window size
    -- $ccz-re-export
    , 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 
import Streaming
import qualified Data.ByteString.Streaming.Internal as I 
import Data.ByteString.Streaming.Internal (ByteString (..)) 



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

-- | Decompress a streaming bytestring. 'Z.WindowBits' is from "Codec.Compression.Zlib" 
--
-- @
-- 'decompress' 'defaultWindowBits' :: 'MonadIO' m => 'ByteString' m r -> 'ByteString' m r
-- @

decompress
  :: MonadIO m
  => Z.WindowBits
  -> ByteString m r -- ^ Compressed stream
  -> ByteString m r -- ^ Decompressed stream
decompress :: WindowBits -> ByteString m r -> ByteString m r
decompress WindowBits
wbits ByteString m r
p0 = do
    Inflate
inf <- IO Inflate -> ByteStream m Inflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inflate -> ByteStream m Inflate)
-> IO Inflate -> ByteStream m Inflate
forall a b. (a -> b) -> a -> b
$ WindowBits -> IO Inflate
Z.initInflate WindowBits
wbits
    r
r <- ByteString m r -> (ByteString -> ByteStream m ()) -> ByteString m r
forall (m :: * -> *) r a.
Monad m =>
ByteStream m r -> (ByteString -> ByteStream m a) -> ByteStream m r
for ByteString m r
p0 ((ByteString -> ByteStream m ()) -> ByteString m r)
-> (ByteString -> ByteStream m ()) -> ByteString m r
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do
       Popper
popper <- IO Popper -> ByteStream m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
       Popper -> ByteStream m ()
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper Popper
popper
    ByteString
bs <- IO ByteString -> ByteStream m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ByteStream m ByteString)
-> IO ByteString -> ByteStream m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.finishInflate Inflate
inf
    Bool -> ByteStream m () -> ByteStream m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteString -> ByteStream m ()
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs)
    r -> ByteString m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE decompress #-}

-- | Decompress a zipped byte stream, returning any leftover input
-- that follows the compressed material.
decompress'
  :: MonadIO m
  => Z.WindowBits
  -> ByteString m r -- ^ Compressed byte stream
  -> ByteString m (Either (ByteString m r) r)
     -- ^ Decompressed byte stream, ending with either leftovers or a result
decompress' :: WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
wbits ByteString m r
p0 = ByteString m r
-> Inflate -> ByteString m (Either (ByteString m r) r)
forall (m :: * -> *) b.
MonadIO m =>
ByteStream m b
-> Inflate -> ByteStream m (Either (ByteStream m b) b)
go ByteString m r
p0 (Inflate -> ByteString m (Either (ByteString m r) r))
-> ByteStream m Inflate -> ByteString m (Either (ByteString m r) r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Inflate -> ByteStream m Inflate
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 <- IO ByteString -> ByteStream m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ByteStream m ByteString)
-> IO ByteString -> ByteStream m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.flushInflate Inflate
inf
      Bool -> ByteStream m () -> ByteStream m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteString -> ByteStream m ()
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 <- m (Either b (ByteString, ByteStream m b))
-> ByteStream m (Either b (ByteString, ByteStream m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteStream m b -> m (Either b (ByteString, ByteStream m b))
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 -> Either (ByteStream m b) b
-> ByteStream m (Either (ByteStream m b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ByteStream m b) b
 -> ByteStream m (Either (ByteStream m b) b))
-> Either (ByteStream m b) b
-> ByteStream m (Either (ByteStream m b) b)
forall a b. (a -> b) -> a -> b
$ b -> Either (ByteStream m b) b
forall a b. b -> Either a b
Right b
r
         Right (ByteString
bs, ByteStream m b
p') -> do
            Popper -> ByteString m ()
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper (Popper -> ByteString m ())
-> ByteStream m Popper -> ByteString m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Popper -> ByteStream m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
            Inflate -> ByteString m ()
forall (m :: * -> *). MonadIO m => Inflate -> ByteStream m ()
flush Inflate
inf
            ByteString
leftover <- IO ByteString -> ByteStream m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ByteStream m ByteString)
-> IO ByteString -> ByteStream m ByteString
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 Either (ByteStream m b) b
-> ByteStream m (Either (ByteStream m b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ByteStream m b) b
 -> ByteStream m (Either (ByteStream m b) b))
-> Either (ByteStream m b) b
-> ByteStream m (Either (ByteStream m b) b)
forall a b. (a -> b) -> a -> b
$ ByteStream m b -> Either (ByteStream m b) b
forall a b. a -> Either a b
Left (ByteString -> ByteString m ()
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
leftover ByteString m () -> ByteStream m b -> ByteStream m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m b
p')
{-# INLINABLE decompress' #-}

-- | Keep decompressing a compressed bytestream until exhausted.
decompressAll :: MonadIO m => Z.WindowBits -> ByteString m r -> ByteString m r
decompressAll :: WindowBits -> ByteString m r -> ByteString m r
decompressAll WindowBits
w ByteString m r
bs = WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
w ByteString m r
bs ByteString m (Either (ByteString m r) r)
-> (Either (ByteString m r) r -> ByteString m r) -> ByteString m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (ByteString m r) r -> ByteString m r
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) = WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
w ByteString m r
bs ByteString m (Either (ByteString m r) r)
-> (Either (ByteString m r) r -> ByteString m r) -> ByteString m r
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) = r -> ByteString m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE decompressAll #-}

-- | Compress a byte stream.
--
-- See the "Codec.Compression.Zlib" module for details about
-- 'Z.CompressionLevel' and 'Z.WindowBits'.

-- @
-- 'compress' 'defaultCompression' 'defaultWindowBits' :: 'MonadIO' m => 'ByteString' m r -> 'ByteString' m r
-- @
-- 
compress
  :: MonadIO m
  => CompressionLevel
  -> Z.WindowBits
  -> ByteString m r -- ^ Decompressed stream
  -> ByteString m r -- ^ Compressed stream
compress :: CompressionLevel -> WindowBits -> ByteString m r -> ByteString m r
compress (CompressionLevel Int
clevel) WindowBits
wbits ByteString m r
p0 = do
    Deflate
def <- IO Deflate -> ByteStream m Deflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deflate -> ByteStream m Deflate)
-> IO Deflate -> ByteStream m Deflate
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> IO Deflate
Z.initDeflate Int
clevel WindowBits
wbits
    let loop :: ByteStream m r -> ByteStream m r
loop ByteStream m r
bs = case ByteStream m r
bs of 
          I.Chunk ByteString
c ByteStream m r
rest -> do
            Popper
popper <- IO Popper -> ByteStream m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> ByteString -> IO Popper
Z.feedDeflate Deflate
def ByteString
c)
            Popper -> ByteString m ()
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper Popper
popper
            ByteStream m r -> ByteStream m r
loop ByteStream m r
rest
          I.Go m (ByteStream m r)
m -> m (ByteStream m r) -> ByteStream m r
forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go ((ByteStream m r -> ByteStream m r)
-> m (ByteStream m r) -> m (ByteStream m r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteStream m r -> ByteStream m r
loop m (ByteStream m r)
m)
          I.Empty r
r -> r -> ByteStream m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
    r
r <- ByteString m r -> ByteString m r
forall (m :: * -> *) r.
MonadIO m =>
ByteStream m r -> ByteStream m r
loop ByteString m r
p0
    Popper -> ByteString m ()
forall (m :: * -> *). MonadIO m => Popper -> ByteString m ()
fromPopper (Popper -> ByteString m ()) -> Popper -> ByteString m ()
forall a b. (a -> b) -> a -> b
$ Deflate -> Popper
Z.finishDeflate Deflate
def
    r -> ByteString m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE compress #-}

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

-- $ccz-re-export
--
-- The following are re-exported from "Codec.Compression.Zlib" for your
-- convenience.

--------------------------------------------------------------------------------
-- Compression Levels

-- | How hard should we try to compress?
newtype CompressionLevel = CompressionLevel Int
                         deriving (Int -> CompressionLevel -> ShowS
[CompressionLevel] -> ShowS
CompressionLevel -> String
(Int -> CompressionLevel -> ShowS)
-> (CompressionLevel -> String)
-> ([CompressionLevel] -> ShowS)
-> Show CompressionLevel
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]
(Int -> ReadS CompressionLevel)
-> ReadS [CompressionLevel]
-> ReadPrec CompressionLevel
-> ReadPrec [CompressionLevel]
-> Read 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
(CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> Eq CompressionLevel
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
Eq CompressionLevel
-> (CompressionLevel -> CompressionLevel -> Ordering)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> Bool)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> (CompressionLevel -> CompressionLevel -> CompressionLevel)
-> Ord 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
$cp1Ord :: Eq CompressionLevel
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

-- | A specific compression level between 0 and 9.
compressionLevel :: Int -> CompressionLevel
compressionLevel :: Int -> CompressionLevel
compressionLevel Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CompressionLevel
CompressionLevel Int
n
  | Bool
otherwise        = String -> CompressionLevel
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

-- | Decompress a gzipped byte stream.

gunzip
  :: MonadIO m
  => ByteString m r -- ^ Compressed stream
  -> ByteString m r -- ^ Decompressed stream
gunzip :: ByteString m r -> ByteString m r
gunzip = WindowBits -> ByteString m r -> ByteString m r
forall (m :: * -> *) r.
MonadIO m =>
WindowBits -> ByteString m r -> ByteString m r
decompress WindowBits
gzWindowBits
{-# INLINABLE gunzip #-}

-- | Decompress a gzipped byte stream, returning any leftover input
-- that follows the compressed stream.
gunzip'
  :: MonadIO m
  => ByteString m r -- ^ Compressed byte stream
  -> ByteString m (Either (ByteString m r) r)
     -- ^ Decompressed bytes stream, returning either a 'ByteString' of 
      -- the leftover input or the return value from the input 'ByteString'.
gunzip' :: ByteString m r -> ByteString m (Either (ByteString m r) r)
gunzip' = WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
forall (m :: * -> *) r.
MonadIO m =>
WindowBits
-> ByteString m r -> ByteString m (Either (ByteString m r) r)
decompress' WindowBits
gzWindowBits
{-# INLINE gunzip' #-}


-- | Compress a byte stream in the gzip format.

gzip
  :: MonadIO m
  => CompressionLevel
  -> ByteString m r -- ^ Decompressed stream
  -> ByteString m r -- ^ Compressed stream
gzip :: CompressionLevel -> ByteString m r -> ByteString m r
gzip CompressionLevel
clevel = CompressionLevel -> WindowBits -> ByteString m r -> ByteString m r
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


--------------------------------------------------------------------------------
-- Internal stuff


for :: ByteStream m r -> (ByteString -> ByteStream m a) -> ByteStream m r
for ByteStream m r
bs0 ByteString -> ByteStream m a
op = ByteStream m r -> ByteStream m r
forall r. ByteStream m r -> ByteStream m r
loop ByteStream m r
bs0 where
  loop :: ByteStream m r -> ByteStream m r
loop ByteStream m r
bs = case ByteStream m r
bs of 
    I.Chunk ByteString
c ByteStream m r
rest -> ByteString -> ByteStream m a
op ByteString
c ByteStream m a -> ByteStream m r -> ByteStream m r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m r -> ByteStream m r
loop ByteStream m r
rest
    I.Go m (ByteStream m r)
m -> m (ByteStream m r) -> ByteStream m r
forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go ((ByteStream m r -> ByteStream m r)
-> m (ByteStream m r) -> m (ByteStream m r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteStream m r -> ByteStream m r
loop m (ByteStream m r)
m)
    I.Empty r
r -> r -> ByteStream m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE for #-}

-- | Produce values from the given 'Z.Popper' until exhausted.
fromPopper :: MonadIO m
           => Z.Popper
           -> ByteString m ()
fromPopper :: Popper -> ByteString m ()
fromPopper Popper
pop = ByteString m ()
loop
  where
    loop :: ByteString m ()
loop = do 
      PopperRes
mbs <- Popper -> ByteStream m PopperRes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Popper
pop
      case PopperRes
mbs of
          PopperRes
PRDone     -> () -> ByteString m ()
forall (m :: * -> *) r. r -> ByteStream m r
I.Empty ()
          PRError ZlibException
e  -> m (ByteString m ()) -> ByteString m ()
forall (m :: * -> *) r. m (ByteStream m r) -> ByteStream m r
I.Go (IO (ByteString m ()) -> m (ByteString m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ZlibException -> IO (ByteString m ())
forall e a. Exception e => e -> IO a
throwIO ZlibException
e))
          PRNext ByteString
bs  -> ByteString -> ByteString m () -> ByteString m ()
forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
I.Chunk ByteString
bs ByteString m ()
loop
{-# INLINABLE fromPopper #-}