zlib-conduit-1.0.0/0000755000000000000000000000000012110322701012266 5ustar0000000000000000zlib-conduit-1.0.0/LICENSE0000644000000000000000000000276712110322701013307 0ustar0000000000000000Copyright (c)2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Michael Snoyman nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. zlib-conduit-1.0.0/Setup.lhs0000644000000000000000000000016212110322701014075 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain zlib-conduit-1.0.0/zlib-conduit.cabal0000644000000000000000000000273112110322701015660 0ustar0000000000000000Name: zlib-conduit Version: 1.0.0 Synopsis: Streaming compression/decompression via conduits. Description: Streaming compression/decompression via conduits. License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit extra-source-files: test/main.hs flag debug Library Exposed-modules: Data.Conduit.Zlib Build-depends: base >= 4 && < 5 , containers , transformers >= 0.2.2 && < 0.4 , bytestring >= 0.9 , zlib-bindings >= 0.1 && < 0.2 , conduit >= 1.0 && < 1.1 , void ghc-options: -Wall test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: conduit , base , hspec >= 1.3 , QuickCheck , bytestring , transformers , zlib-conduit , resourcet ghc-options: -Wall source-repository head type: git location: git://github.com/snoyberg/conduit.git zlib-conduit-1.0.0/test/0000755000000000000000000000000012110322701013245 5ustar0000000000000000zlib-conduit-1.0.0/test/main.hs0000644000000000000000000000343312110322701014530 0ustar0000000000000000import Test.Hspec import Test.Hspec.QuickCheck (prop) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Conduit.Zlib as CZ import Control.Monad.ST (runST) import Data.Monoid import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Lazy.Char8 () import Control.Monad.Trans.Resource (runExceptionT_) main :: IO () main = hspec $ do describe "zlib" $ do prop "idempotent" $ \bss' -> runST $ do let bss = map S.pack bss' lbs = L.fromChunks bss src = mconcat $ map (CL.sourceList . return) bss outBss <- runExceptionT_ $ src C.$= CZ.gzip C.$= CZ.ungzip C.$$ CL.consume return $ lbs == L.fromChunks outBss prop "flush" $ \bss' -> runST $ do let bss = map S.pack $ filter (not . null) bss' bssC = concatMap (\bs -> [C.Chunk bs, C.Flush]) bss src = mconcat $ map (CL.sourceList . return) bssC outBssC <- runExceptionT_ $ src C.$= CZ.compressFlush 5 (CZ.WindowBits 31) C.$= CZ.decompressFlush (CZ.WindowBits 31) C.$$ CL.consume return $ bssC == outBssC it "compressFlush large data" $ do let content = L.pack $ map (fromIntegral . fromEnum) $ concat $ ["BEGIN"] ++ map show [1..100000 :: Int] ++ ["END"] src = CL.sourceList $ map C.Chunk $ L.toChunks content bssC <- src C.$$ CZ.compressFlush 5 (CZ.WindowBits 31) C.=$ CL.consume let unChunk (C.Chunk x) = [x] unChunk C.Flush = [] bss <- CL.sourceList bssC C.$$ CL.concatMap unChunk C.=$ CZ.ungzip C.=$ CL.consume L.fromChunks bss `shouldBe` content zlib-conduit-1.0.0/Data/0000755000000000000000000000000012110322701013137 5ustar0000000000000000zlib-conduit-1.0.0/Data/Conduit/0000755000000000000000000000000012110322701014544 5ustar0000000000000000zlib-conduit-1.0.0/Data/Conduit/Zlib.hs0000644000000000000000000001215112110322701016000 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -- | Streaming compression and decompression using conduits. -- -- Parts of this code were taken from zlib-enum and adapted for conduits. module Data.Conduit.Zlib ( -- * Conduits compress, decompress, gzip, ungzip, -- * Flushing compressFlush, decompressFlush, -- * Re-exported from zlib-bindings WindowBits (..), defaultWindowBits ) where import Codec.Zlib import Data.Conduit hiding (unsafeLiftIO) import qualified Data.Conduit as C (unsafeLiftIO) import Data.ByteString (ByteString) import qualified Data.ByteString as S import Control.Exception (try) import Control.Monad ((<=<), unless, liftM) import Control.Monad.Trans.Class (lift, MonadTrans) -- | Gzip compression with default parameters. gzip :: (MonadThrow m, MonadUnsafeIO m) => Conduit ByteString m ByteString gzip = compress 1 (WindowBits 31) -- | Gzip decompression with default parameters. ungzip :: (MonadUnsafeIO m, MonadThrow m) => Conduit ByteString m ByteString ungzip = decompress (WindowBits 31) unsafeLiftIO :: (MonadUnsafeIO m, MonadThrow m) => IO a -> m a unsafeLiftIO = either rethrow return <=< C.unsafeLiftIO . try where rethrow :: MonadThrow m => ZlibException -> m a rethrow = monadThrow -- | -- Decompress (inflate) a stream of 'ByteString's. For example: -- -- > sourceFile "test.z" $= decompress defaultWindowBits $$ sinkFile "test" decompress :: (MonadUnsafeIO m, MonadThrow m) => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit ByteString m ByteString decompress = helperDecompress (liftM (fmap Chunk) await) yield' where yield' Flush = return () yield' (Chunk bs) = yield bs -- | Same as 'decompress', but allows you to explicitly flush the stream. decompressFlush :: (MonadUnsafeIO m, MonadThrow m) => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit (Flush ByteString) m (Flush ByteString) decompressFlush = helperDecompress await yield helperDecompress :: (Monad (t m), MonadUnsafeIO m, MonadThrow m, MonadTrans t) => t m (Maybe (Flush ByteString)) -> (Flush ByteString -> t m ()) -> WindowBits -> t m () helperDecompress await' yield' config = await' >>= maybe (return ()) start where start input = do inf <- lift $ unsafeLiftIO $ initInflate config push inf input continue inf = await' >>= maybe (close inf) (push inf) goPopper popper = do mbs <- lift $ unsafeLiftIO popper case mbs of Nothing -> return () Just bs -> yield' (Chunk bs) >> goPopper popper push inf (Chunk x) = do popper <- lift $ unsafeLiftIO $ feedInflate inf x goPopper popper continue inf push inf Flush = do chunk <- lift $ unsafeLiftIO $ flushInflate inf unless (S.null chunk) $ yield' $ Chunk chunk yield' Flush continue inf close inf = do chunk <- lift $ unsafeLiftIO $ finishInflate inf unless (S.null chunk) $ yield' $ Chunk chunk -- | -- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control -- the format (zlib vs. gzip). compress :: (MonadUnsafeIO m, MonadThrow m) => Int -- ^ Compression level -> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit ByteString m ByteString compress = helperCompress (liftM (fmap Chunk) await) yield' where yield' Flush = return () yield' (Chunk bs) = yield bs -- | Same as 'compress', but allows you to explicitly flush the stream. compressFlush :: (MonadUnsafeIO m, MonadThrow m) => Int -- ^ Compression level -> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit (Flush ByteString) m (Flush ByteString) compressFlush = helperCompress await yield helperCompress :: (Monad (t m), MonadUnsafeIO m, MonadThrow m, MonadTrans t) => t m (Maybe (Flush ByteString)) -> (Flush ByteString -> t m ()) -> Int -> WindowBits -> t m () helperCompress await' yield' level config = await' >>= maybe (return ()) start where start input = do def <- lift $ unsafeLiftIO $ initDeflate level config push def input continue def = await' >>= maybe (close def) (push def) goPopper popper = do mbs <- lift $ unsafeLiftIO popper case mbs of Nothing -> return () Just bs -> yield' (Chunk bs) >> goPopper popper push def (Chunk x) = do popper <- lift $ unsafeLiftIO $ feedDeflate def x goPopper popper continue def push def Flush = do mchunk <- lift $ unsafeLiftIO $ flushDeflate def maybe (return ()) (yield' . Chunk) mchunk yield' Flush continue def close def = do mchunk <- lift $ unsafeLiftIO $ finishDeflate def case mchunk of Nothing -> return () Just chunk -> yield' (Chunk chunk) >> close def