zlib-conduit 0.2.0.1 → 0.3.0
raw patch · 3 files changed
+98/−74 lines, 3 filesdep ~conduitdep ~zlib-bindings
Dependency ranges changed: conduit, zlib-bindings
Files
- Data/Conduit/Zlib.hs +93/−68
- test/main.hs +2/−3
- zlib-conduit.cabal +3/−3
Data/Conduit/Zlib.hs view
@@ -15,15 +15,13 @@ import Data.Conduit import Data.ByteString (ByteString) import qualified Data.ByteString as S-import Control.Monad.Trans.Resource-import Control.Monad.Trans.Class -- | Gzip compression with default parameters.-gzip :: ResourceUnsafeIO m => Conduit ByteString m ByteString+gzip :: MonadUnsafeIO m => Conduit ByteString m ByteString gzip = compress 1 (WindowBits 31) -- | Gzip decompression with default parameters.-ungzip :: ResourceUnsafeIO m => Conduit ByteString m ByteString+ungzip :: MonadUnsafeIO m => Conduit ByteString m ByteString ungzip = decompress (WindowBits 31) -- |@@ -32,99 +30,126 @@ -- > sourceFile "test.z" $= decompress defaultWindowBits $$ sinkFile "test" decompress- :: ResourceUnsafeIO m+ :: MonadUnsafeIO m => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit ByteString m ByteString-decompress config = Conduit- { conduitPush = \input -> do- inf <- lift $ unsafeFromIO $ initInflate config- push inf input- , conduitClose = return []- }+decompress config = NeedInput+ (\input -> ConduitM (do+ inf <- unsafeLiftIO $ initInflate config+ push inf input) (return ()))+ Closed where- mkCon inf = Conduit (push inf) (close inf)+ push' inf x = ConduitM (push inf x) (return ())+ push inf x = do- chunks <- lift $ unsafeFromIO $ withInflateInput inf x callback- return $ Producing (mkCon inf) chunks- close inf = do- chunk <- lift $ unsafeFromIO $ finishInflate inf- return $ if S.null chunk then [] else [chunk]+ popper <- unsafeLiftIO $ feedInflate inf x+ goPopper (push' inf) (close inf) id [] popper + close inf = flip SourceM (return ()) $ do+ chunk <- unsafeLiftIO $ finishInflate inf+ return $+ if S.null chunk+ then Closed+ else Open Closed (return ()) chunk+ -- | Same as 'decompress', but allows you to explicitly flush the stream. decompressFlush- :: ResourceUnsafeIO m+ :: MonadUnsafeIO m => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Conduit (Flush ByteString) m (Flush ByteString)-decompressFlush config = Conduit- { conduitPush = \input -> do- inf <- lift $ unsafeFromIO $ initInflate config- push inf input- , conduitClose = return []- }+decompressFlush config = NeedInput+ (\input -> flip ConduitM (return ()) $ do+ inf <- unsafeLiftIO $ initInflate config+ push inf input)+ Closed where- mkCon inf = Conduit (push inf) (close inf)+ push' inf x = ConduitM (push inf x) (return ())+ push inf (Chunk x) = do- chunks <- lift $ unsafeFromIO $ withInflateInput inf x callback- return $ Producing (mkCon inf) $ map Chunk chunks+ popper <- unsafeLiftIO $ feedInflate inf x+ goPopper (push' inf) (close inf) Chunk [] popper push inf Flush = do- chunk <- lift $ unsafeFromIO $ flushInflate inf- let chunk' = if S.null chunk then id else (Chunk chunk:)- return $ Producing (mkCon inf) $ chunk' [Flush]- close inf = do- chunk <- lift $ unsafeFromIO $ finishInflate inf- return $ if S.null chunk then [] else [Chunk chunk]+ 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) + close inf = flip SourceM (return ()) $ do+ chunk <- unsafeLiftIO $ finishInflate inf+ return $+ if S.null chunk+ then Closed+ else Open Closed (return ()) $ Chunk chunk+ -- | -- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control -- the format (zlib vs. gzip). compress- :: ResourceUnsafeIO m+ :: MonadUnsafeIO 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 = Conduit- { conduitPush = \input -> do- def <- lift $ unsafeFromIO $ initDeflate level config- push def input- , conduitClose = return []- }+compress level config = NeedInput+ (\input -> flip ConduitM (return ()) $ do+ def <- unsafeLiftIO $ initDeflate level config+ push def input) Closed where+ push' def input = ConduitM (push def input) (return ()) push def x = do- chunks <- lift $ unsafeFromIO $ withDeflateInput def x callback- return $ Producing (Conduit (push def) (close def)) chunks- close def = do- chunks <- lift $ unsafeFromIO $ finishDeflate def callback- return chunks+ popper <- unsafeLiftIO $ feedDeflate def x+ goPopper (push' def) (close def) id [] popper + close def = slurp $ unsafeLiftIO $ finishDeflate def+ -- | Same as 'compress', but allows you to explicitly flush the stream. compressFlush- :: ResourceUnsafeIO m+ :: MonadUnsafeIO 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 = Conduit- { conduitPush = \input -> do- def <- lift $ unsafeFromIO $ initDeflate level config- push def input- , conduitClose = return []- }+compressFlush level config = NeedInput+ (\input -> flip ConduitM (return ()) $ do+ def <- unsafeLiftIO $ initDeflate level config+ push def input) Closed where- mkCon def = Conduit (push def) (close def)+ push' def input = ConduitM (push def input) (return ())+ push def (Chunk x) = do- chunks <- lift $ unsafeFromIO $ withDeflateInput def x callback- return $ Producing (mkCon def) $ map Chunk chunks- push def Flush = do- chunks <- lift $ unsafeFromIO $ flushDeflate def callback- return $ Producing (mkCon def) $ map Chunk chunks ++ [Flush]- close def = do- chunks <- lift $ unsafeFromIO $ finishDeflate def callback- return $ map Chunk chunks+ popper <- unsafeLiftIO $ feedDeflate def x+ goPopper (push' def) (close def) Chunk [] popper+ push def Flush = goPopper (push' def) (close def) Chunk [Flush] $ flushDeflate def -callback :: Monad m => m (Maybe a) -> m [a]-callback pop = go id where- go front = do- x <- pop- case x of- Nothing -> return $ front []- Just y -> go (front . (:) y)+ close def = flip SourceM (return ()) $ do+ mchunk <- unsafeLiftIO $ finishDeflate def+ return $ case mchunk of+ Nothing -> Closed+ Just chunk -> Open Closed (return ()) (Chunk chunk)++goPopper :: MonadUnsafeIO m+ => ConduitPush input m output+ -> ConduitClose 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 (ConduitM (goPopper push close wrap final popper) (return ())) (return ()) (wrap bs)++slurp :: Monad m => m (Maybe a) -> Source m a+slurp pop = flip SourceM (return ()) $ do+ x <- pop+ return $ case x of+ Nothing -> Closed+ Just y -> Open (slurp pop) (return ()) y
test/main.hs view
@@ -5,7 +5,6 @@ import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Conduit.Zlib as CZ-import Data.Conduit (runResourceT) import Control.Monad.ST (runST) import Data.Monoid import qualified Data.ByteString as S@@ -15,13 +14,13 @@ main :: IO () main = hspecX $ do describe "zlib" $ do- prop "idempotent" $ \bss' -> runST $ runResourceT $ do+ prop "idempotent" $ \bss' -> runST $ do let bss = map S.pack bss' lbs = L.fromChunks bss src = mconcat $ map (CL.sourceList . return) bss outBss <- src C.$= CZ.gzip C.$= CZ.ungzip C.$$ CL.consume return $ lbs == L.fromChunks outBss- prop "flush" $ \bss' -> runST $ runResourceT $ do+ 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
zlib-conduit.cabal view
@@ -1,5 +1,5 @@ Name: zlib-conduit-Version: 0.2.0.1+Version: 0.3.0 Synopsis: Streaming compression/decompression via conduits. Description: Streaming compression/decompression via conduits. License: BSD3@@ -20,8 +20,8 @@ , containers , transformers >= 0.2.2 && < 0.3 , bytestring >= 0.9- , zlib-bindings >= 0.0.3 && < 0.1- , conduit >= 0.2 && < 0.3+ , zlib-bindings >= 0.1 && < 0.2+ , conduit >= 0.3 && < 0.4 ghc-options: -Wall test-suite test