{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This module exports utilities to compress and decompress @pipes@ streams
-- using the zlib compression codec.
--
-- If you want to compress or decompress GZip streams, use the "Pipes.GZip"
-- module instead.

module Pipes.Zlib (
  -- * Streams
    decompress
  , decompress'
  , compress

  -- * 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           Pipes

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

-- | Decompress bytes flowing from a 'Producer'.
--
-- See the "Codec.Compression.Zlib" module for details about 'Z.WindowBits'.
--
-- @
-- 'decompress' :: 'MonadIO' m
--            => 'Z.WindowBits'
--            => 'Producer' 'B.ByteString' m r
--            -> 'Producer' 'B.ByteString' m r
-- @
decompress
  :: MonadIO m
  => Z.WindowBits
  -> Proxy x' x () B.ByteString m r -- ^ Compressed stream
  -> Proxy x' x () B.ByteString m r -- ^ Decompressed stream
decompress :: WindowBits
-> Proxy x' x () ByteString m r -> Proxy x' x () ByteString m r
decompress wbits :: WindowBits
wbits p0 :: Proxy x' x () ByteString m r
p0 = do
    Inflate
inf <- IO Inflate -> Proxy x' x () ByteString m Inflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Inflate -> Proxy x' x () ByteString m Inflate)
-> IO Inflate -> Proxy x' x () ByteString m Inflate
forall a b. (a -> b) -> a -> b
$ WindowBits -> IO Inflate
Z.initInflate WindowBits
wbits
    r
r <- Proxy x' x () ByteString m r
-> (ByteString -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy x' x () ByteString m r
p0 ((ByteString -> Proxy x' x () ByteString m ())
 -> Proxy x' x () ByteString m r)
-> (ByteString -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m r
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs -> do
       Popper
popper <- IO Popper -> Proxy x' x () ByteString m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
       Popper -> Producer' ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Popper -> Producer' ByteString m ()
fromPopper Popper
popper
    ByteString
bs <- IO ByteString -> Proxy x' x () ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Proxy x' x () ByteString m ByteString)
-> IO ByteString -> Proxy x' x () ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.finishInflate Inflate
inf
    Bool
-> Proxy x' x () ByteString m () -> Proxy x' x () ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
bs)
    r -> Proxy x' x () ByteString m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
{-# INLINABLE decompress #-}

-- | Decompress bytes flowing from a 'Producer', returning any leftover input
-- that follows the compressed stream.
decompress'
  :: MonadIO m
  => Z.WindowBits
  -> Producer B.ByteString m r -- ^ Compressed stream
  -> Producer B.ByteString m (Either (Producer B.ByteString m r) r)
     -- ^ Decompressed stream, ending with either leftovers or a result
decompress' :: WindowBits
-> Producer ByteString m r
-> Producer ByteString m (Either (Producer ByteString m r) r)
decompress' wbits :: WindowBits
wbits p0 :: Producer ByteString m r
p0 = Producer ByteString m r
-> Inflate
-> Producer ByteString m (Either (Producer ByteString m r) r)
forall (m :: * -> *) b x' x.
MonadIO m =>
Producer ByteString m b
-> Inflate
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
go Producer ByteString m r
p0 (Inflate
 -> Producer ByteString m (Either (Producer ByteString m r) r))
-> Proxy X () () ByteString m Inflate
-> Producer ByteString m (Either (Producer ByteString m r) r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Inflate -> Proxy X () () ByteString m Inflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WindowBits -> IO Inflate
Z.initInflate WindowBits
wbits)
  where
    flush :: Inflate -> Proxy x' x () ByteString m ()
flush inf :: Inflate
inf = do
      ByteString
bs <- IO ByteString -> Proxy x' x () ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Proxy x' x () ByteString m ByteString)
-> IO ByteString -> Proxy x' x () ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.flushInflate Inflate
inf
      Bool
-> Proxy x' x () ByteString m () -> Proxy x' x () ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
bs)
    go :: Producer ByteString m b
-> Inflate
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
go p :: Producer ByteString m b
p inf :: Inflate
inf = do
      Either b (ByteString, Producer ByteString m b)
res <- m (Either b (ByteString, Producer ByteString m b))
-> Proxy
     x'
     x
     ()
     ByteString
     m
     (Either b (ByteString, Producer ByteString m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer ByteString m b
-> m (Either b (ByteString, Producer ByteString m b))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer ByteString m b
p)
      case Either b (ByteString, Producer ByteString m b)
res of
         Left r :: b
r -> Either (Producer ByteString m b) b
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Producer ByteString m b) b
 -> Proxy x' x () ByteString m (Either (Producer ByteString m b) b))
-> Either (Producer ByteString m b) b
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
forall a b. (a -> b) -> a -> b
$ b -> Either (Producer ByteString m b) b
forall a b. b -> Either a b
Right b
r
         Right (bs :: ByteString
bs, p' :: Producer ByteString m b
p') -> do
            Popper -> Proxy x' x () ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Popper -> Producer' ByteString m ()
fromPopper (Popper -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m Popper
-> Proxy x' x () ByteString m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Popper -> Proxy x' x () ByteString m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Inflate -> ByteString -> IO Popper
Z.feedInflate Inflate
inf ByteString
bs)
            Inflate -> Proxy x' x () ByteString m ()
forall (m :: * -> *) x' x.
MonadIO m =>
Inflate -> Proxy x' x () ByteString m ()
flush Inflate
inf
            ByteString
leftover <- IO ByteString -> Proxy x' x () ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Proxy x' x () ByteString m ByteString)
-> IO ByteString -> Proxy x' x () ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Inflate -> IO ByteString
Z.getUnusedInflate Inflate
inf
            if ByteString -> Bool
B.null ByteString
leftover
               then Producer ByteString m b
-> Inflate
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
go Producer ByteString m b
p' Inflate
inf
               else Either (Producer ByteString m b) b
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Producer ByteString m b) b
 -> Proxy x' x () ByteString m (Either (Producer ByteString m b) b))
-> Either (Producer ByteString m b) b
-> Proxy x' x () ByteString m (Either (Producer ByteString m b) b)
forall a b. (a -> b) -> a -> b
$ Producer ByteString m b -> Either (Producer ByteString m b) b
forall a b. a -> Either a b
Left (ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
leftover Proxy X () () ByteString m ()
-> Producer ByteString m b -> Producer ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer ByteString m b
p')
{-# INLINABLE decompress' #-}

-- | Compress bytes flowing from a 'Producer'.
--
-- See the "Codec.Compression.Zlib" module for details about
-- 'Z.CompressionLevel' and 'Z.WindowBits'.
--
-- @
-- 'compress' :: 'MonadIO' m
--          => 'Z.CompressionLevel'
--          -> 'Z.WindowBits'
--          -> 'Producer' 'B.ByteString' m r
--          -> 'Producer' 'B.ByteString' m r
-- @
compress
  :: MonadIO m
  => CompressionLevel
  -> Z.WindowBits
  -> Proxy x' x () B.ByteString m r -- ^ Decompressed stream
  -> Proxy x' x () B.ByteString m r -- ^ Compressed stream
compress :: CompressionLevel
-> WindowBits
-> Proxy x' x () ByteString m r
-> Proxy x' x () ByteString m r
compress (CompressionLevel clevel :: Int
clevel) wbits :: WindowBits
wbits p0 :: Proxy x' x () ByteString m r
p0 = do
    Deflate
def <- IO Deflate -> Proxy x' x () ByteString m Deflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deflate -> Proxy x' x () ByteString m Deflate)
-> IO Deflate -> Proxy x' x () ByteString m Deflate
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits -> IO Deflate
Z.initDeflate Int
clevel WindowBits
wbits
    r
r <- Proxy x' x () ByteString m r
-> (ByteString -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy x' x () ByteString m r
p0 ((ByteString -> Proxy x' x () ByteString m ())
 -> Proxy x' x () ByteString m r)
-> (ByteString -> Proxy x' x () ByteString m ())
-> Proxy x' x () ByteString m r
forall a b. (a -> b) -> a -> b
$ \bs :: ByteString
bs -> do
       Popper
popper <- IO Popper -> Proxy x' x () ByteString m Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> ByteString -> IO Popper
Z.feedDeflate Deflate
def ByteString
bs)
       Popper -> Producer' ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Popper -> Producer' ByteString m ()
fromPopper Popper
popper
    Popper -> Proxy x' x () ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Popper -> Producer' ByteString m ()
fromPopper (Popper -> Proxy x' x () ByteString m ())
-> Popper -> Proxy x' x () ByteString m ()
forall a b. (a -> b) -> a -> b
$ Deflate -> Popper
Z.finishDeflate Deflate
def
    r -> Proxy x' x () 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 (-1)
noCompression :: CompressionLevel
noCompression      = Int -> CompressionLevel
CompressionLevel 0
bestSpeed :: CompressionLevel
bestSpeed          = Int -> CompressionLevel
CompressionLevel 1
bestCompression :: CompressionLevel
bestCompression    = Int -> CompressionLevel
CompressionLevel 9

-- | A specific compression level between 0 and 9.
compressionLevel :: Int -> CompressionLevel
compressionLevel :: Int -> CompressionLevel
compressionLevel n :: Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 9 = Int -> CompressionLevel
CompressionLevel Int
n
  | Bool
otherwise        = String -> CompressionLevel
forall a. HasCallStack => String -> a
error "CompressionLevel must be in the range 0..9"

windowBits :: Int -> WindowBits
windowBits :: Int -> WindowBits
windowBits = Int -> WindowBits
WindowBits

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

-- | Produce values from the given 'Z.Popper' until exhausted.
fromPopper :: MonadIO m
           => Z.Popper
           -> Producer' B.ByteString m ()
fromPopper :: Popper -> Producer' ByteString m ()
fromPopper pop :: Popper
pop = Proxy x' x () ByteString m ()
Producer' ByteString m ()
loop
  where
    loop :: Proxy x' x () ByteString m ()
loop = do
      PopperRes
mbs <- Popper -> Proxy x' x () ByteString m PopperRes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Popper
pop
      case PopperRes
mbs of
          PRDone     -> () -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          PRError e :: ZlibException
e  -> IO () -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Proxy x' x () ByteString m ())
-> IO () -> Proxy x' x () ByteString m ()
forall a b. (a -> b) -> a -> b
$ ZlibException -> IO ()
forall e a. Exception e => e -> IO a
throwIO ZlibException
e
          PRNext bs :: ByteString
bs  -> ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
bs Proxy x' x () ByteString m ()
-> Proxy x' x () ByteString m () -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy x' x () ByteString m ()
loop
{-# INLINABLE fromPopper #-}