-- | This module exports utilities to compress and decompress @pipes@ streams -- using the zlib compression codec. module Control.Proxy.Zlib ( -- * Streams decompressD , compressD -- * Compression level -- $ccz-re-export , ZC.defaultCompression , ZC.noCompression , ZC.bestSpeed , ZC.bestCompression , ZC.compressionLevel -- * Window size -- $ccz-re-export , ZC.defaultWindowBits , ZC.windowBits ) where import qualified Codec.Zlib as Z import qualified Codec.Compression.Zlib as ZC import Control.Monad (forever, unless) import Control.Monad.Trans.Class (lift) import Control.Proxy ((>->)) import qualified Control.Proxy as P import qualified Data.ByteString as B import Data.Traversable (mapM) import Prelude hiding (mapM) -------------------------------------------------------------------------------- -- | Decompress bytes flowing downstream using the given 'Z.WindowBits'. -- -- See the "Codec.Zlib" module for details about this values. decompressD :: P.Proxy p => Z.WindowBits -> () -> P.Pipe p B.ByteString B.ByteString IO r decompressD config () = P.runIdentityP . forever $ do inf <- lift (Z.initInflate config) popper <- lift . Z.feedInflate inf =<< P.request () (P.unitD >-> fromPopperS popper) () bs <- lift (Z.finishInflate inf) unless (B.null bs) $ P.respond bs -- | Compress bytes flowing downstream. -- -- See the "Codec.Zlib" module for details about these values. compressD :: P.Proxy p => ZC.CompressionLevel -> Z.WindowBits -> () -> P.Pipe p B.ByteString B.ByteString IO r compressD level config () = P.runIdentityP loop where loop = forever $ do def <- lift (Z.initDeflate level' config) popper <- lift . Z.feedDeflate def =<< P.request () (P.unitD >-> fromPopperS popper) () mapM P.respond =<< lift (Z.finishDeflate def) level' = fromCompressionLevel level -------------------------------------------------------------------------------- -- $ccz-re-export -- -- The following are re-exported from "Codec.Compression.Zlib" for your -- convenience. -------------------------------------------------------------------------------- -- Internal stuff -- | Produce values from the given 'Z.Poppler' until exhausted. fromPopperS :: P.Proxy p => Z.Popper -> () -> P.Producer p B.ByteString IO () fromPopperS pop () = P.runIdentityP loop where loop = do mbs <- lift pop case mbs of Nothing -> return () Just bs -> P.respond bs >> loop -- We need this function until the @zlib@ library hides the -- 'ZC.CompressionLevel' constructors in future version 0.7. fromCompressionLevel :: ZC.CompressionLevel -> Int fromCompressionLevel level = case level of ZC.DefaultCompression -> -1 ZC.NoCompression -> 0 ZC.BestSpeed -> 1 ZC.BestCompression -> 9 ZC.CompressionLevel n | n >= 0 && n <= 9 -> fromIntegral n _ -> error "CompressLevel must be in the range 1..9"