zlib-conduit 0.4.0.2 → 0.5.0
raw patch · 3 files changed
+86/−95 lines, 3 filesdep +voiddep ~basedep ~conduit
Dependencies added: void
Dependency ranges changed: base, conduit
Files
- Data/Conduit/Zlib.hs +73/−92
- test/main.hs +10/−1
- zlib-conduit.cabal +3/−2
Data/Conduit/Zlib.hs view
@@ -12,19 +12,20 @@ ) where import Codec.Zlib-import Data.Conduit hiding (unsafeLiftIO)-import qualified Data.Conduit as C+import Data.Conduit hiding (unsafeLiftIO, Source, Sink, Conduit, Pipe)+import qualified Data.Conduit as C (unsafeLiftIO) import Data.ByteString (ByteString) import qualified Data.ByteString as S import Control.Exception (try)-import Control.Monad ((<=<))+import Control.Monad ((<=<), unless)+import Control.Monad.Trans.Class (lift) -- | Gzip compression with default parameters.-gzip :: (MonadThrow m, MonadUnsafeIO m) => Conduit ByteString m ByteString+gzip :: (MonadThrow m, MonadUnsafeIO m) => GInfConduit ByteString m ByteString gzip = compress 1 (WindowBits 31) -- | Gzip decompression with default parameters.-ungzip :: (MonadUnsafeIO m, MonadThrow m) => Conduit ByteString m ByteString+ungzip :: (MonadUnsafeIO m, MonadThrow m) => GInfConduit ByteString m ByteString ungzip = decompress (WindowBits 31) unsafeLiftIO :: (MonadUnsafeIO m, MonadThrow m) => IO a -> m a@@ -42,59 +43,51 @@ 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 config = NeedInput- (\input -> PipeM (do- inf <- unsafeLiftIO $ initInflate config- push inf input) (return ()))- (Done Nothing ())+ -> GInfConduit ByteString m ByteString+decompress =+ mapOutput unChunk . mapInput Chunk unChunk' . decompressFlush where- push' inf x = PipeM (push inf x) (return ())-- push inf x = do- popper <- unsafeLiftIO $ feedInflate inf x- goPopper (push' inf) (close inf) id [] popper+ unChunk Flush = S.empty+ unChunk (Chunk bs) = bs - close inf = flip PipeM (return ()) $ do- chunk <- unsafeLiftIO $ finishInflate inf- return $- if S.null chunk- then Done Nothing ()- else HaveOutput (Done Nothing ()) (return ()) chunk+ unChunk' Flush = Nothing+ unChunk' (Chunk bs) = Just 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 config = NeedInput- (\input -> flip PipeM (return ()) $ do- inf <- unsafeLiftIO $ initInflate config- push inf input)- (Done Nothing ())+ -> GInfConduit (Flush ByteString) m (Flush ByteString)+decompressFlush config =+ awaitE >>= either return start where- push' inf x = PipeM (push inf x) (return ())+ start input = do+ inf <- lift $ unsafeLiftIO $ initInflate config+ push inf input + continue inf = awaitE >>= either (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 <- unsafeLiftIO $ feedInflate inf x- goPopper (push' inf) (close inf) Chunk [] popper+ popper <- lift $ unsafeLiftIO $ feedInflate inf x+ goPopper popper+ continue inf+ push inf Flush = do- chunk <- unsafeLiftIO $ flushInflate inf- let next = HaveOutput- (NeedInput (push' inf) (close inf))- (return ())- Flush- return $- if S.null chunk- then next- else HaveOutput next (return ()) (Chunk chunk)+ chunk <- lift $ unsafeLiftIO $ flushInflate inf+ unless (S.null chunk) $ yield $ Chunk chunk+ yield Flush+ continue inf - close inf = flip PipeM (return ()) $ do- chunk <- unsafeLiftIO $ finishInflate inf- return $- if S.null chunk- then Done Nothing ()- else HaveOutput (Done Nothing ()) (return ()) $ Chunk chunk+ close inf ret = do+ chunk <- lift $ unsafeLiftIO $ finishInflate inf+ unless (S.null chunk) $ yield $ Chunk chunk+ return ret -- | -- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control@@ -104,62 +97,50 @@ :: (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 level config = NeedInput- (\input -> flip PipeM (return ()) $ do- def <- unsafeLiftIO $ initDeflate level config- push def input) (Done Nothing ())+ -> GInfConduit ByteString m ByteString+compress level =+ mapOutput unChunk . mapInput Chunk unChunk' . compressFlush level where- push' def input = PipeM (push def input) (return ())- push def x = do- popper <- unsafeLiftIO $ feedDeflate def x- goPopper (push' def) (close def) id [] popper+ unChunk Flush = S.empty+ unChunk (Chunk bs) = bs - close def = slurp $ unsafeLiftIO $ finishDeflate def+ unChunk' Flush = Nothing+ unChunk' (Chunk bs) = Just 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 level config = NeedInput- (\input -> flip PipeM (return ()) $ do- def <- unsafeLiftIO $ initDeflate level config- push def input) (Done Nothing ())+ -> GInfConduit (Flush ByteString) m (Flush ByteString)+compressFlush level config =+ awaitE >>= either return start where- push' def input = PipeM (push def input) (return ())+ start input = do+ def <- lift $ unsafeLiftIO $ initDeflate level config+ push def input - push def (Chunk x) = do- popper <- unsafeLiftIO $ feedDeflate def x- goPopper (push' def) (close def) Chunk [] popper- push def Flush = goPopper (push' def) (close def) Chunk [Flush] $ flushDeflate def+ continue def = awaitE >>= either (close def) (push def) - close def = flip PipeM (return ()) $ do- mchunk <- unsafeLiftIO $ finishDeflate def- return $ case mchunk of- Nothing -> Done Nothing ()- Just chunk -> HaveOutput (close def) (return ()) (Chunk chunk)+ goPopper popper = do+ mbs <- lift $ unsafeLiftIO popper+ case mbs of+ Nothing -> return ()+ Just bs -> yield (Chunk bs) >> goPopper popper -goPopper :: (MonadUnsafeIO m, MonadThrow m)- => (input -> Conduit input m output)- -> Conduit input m output- -> (S.ByteString -> output)- -> [output]- -> Popper- -> m (Conduit input m output)-goPopper push close wrap final popper = do- mbs <- unsafeLiftIO popper- return $ case mbs of- Nothing ->- let go [] = NeedInput push close- go (x:xs) = HaveOutput (go xs) (return ()) x- in go final- Just bs -> HaveOutput (PipeM (goPopper push close wrap final popper) (return ())) (return ()) (wrap bs)+ push def (Chunk x) = do+ popper <- lift $ unsafeLiftIO $ feedDeflate def x+ goPopper popper+ continue def -slurp :: Monad m => m (Maybe a) -> Pipe i a m ()-slurp pop = flip PipeM (return ()) $ do- x <- pop- return $ case x of- Nothing -> Done Nothing ()- Just y -> HaveOutput (slurp pop) (return ()) y+ push def Flush = do+ mchunk <- lift $ unsafeLiftIO $ flushDeflate def+ maybe (return ()) (yield . Chunk) mchunk+ yield Flush+ continue def++ close def ret = do+ mchunk <- lift $ unsafeLiftIO $ finishDeflate def+ case mchunk of+ Nothing -> return ret+ Just chunk -> yield (Chunk chunk) >> close def ret
test/main.hs view
@@ -1,6 +1,7 @@ import Test.Hspec.Monadic import Test.Hspec.HUnit () import Test.Hspec.QuickCheck (prop)+import Test.HUnit import qualified Data.Conduit as C import qualified Data.Conduit.List as CL@@ -13,7 +14,7 @@ import Control.Monad.Trans.Resource (runExceptionT_) main :: IO ()-main = hspecX $ do+main = hspec $ do describe "zlib" $ do prop "idempotent" $ \bss' -> runST $ do let bss = map S.pack bss'@@ -30,3 +31,11 @@ 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 @?= content
zlib-conduit.cabal view
@@ -1,5 +1,5 @@ Name: zlib-conduit-Version: 0.4.0.2+Version: 0.5.0 Synopsis: Streaming compression/decompression via conduits. Description: Streaming compression/decompression via conduits. License: BSD3@@ -21,7 +21,8 @@ , transformers >= 0.2.2 && < 0.4 , bytestring >= 0.9 , zlib-bindings >= 0.1 && < 0.2- , conduit >= 0.4 && < 0.5+ , conduit >= 0.5 && < 0.6+ , void ghc-options: -Wall test-suite test