bzlib-conduit 0.2.1.5 → 0.3.0
raw patch · 9 files changed
+358/−317 lines, 9 filesdep −QuickCheckdep −conduit-extradep ~basedep ~bytestringdep ~conduitPVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, conduit-extra
Dependency ranges changed: base, bytestring, conduit, resourcet
API changes (from Hackage documentation)
+ Data.Conduit.BZlib.Internal: C'bz_stream :: Ptr CChar -> CUInt -> CUInt -> CUInt -> Ptr CChar -> CUInt -> CUInt -> CUInt -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> C'bz_stream
+ Data.Conduit.BZlib.Internal: [c'bz_stream'avail_in] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: [c'bz_stream'avail_out] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: [c'bz_stream'bzalloc] :: C'bz_stream -> Ptr ()
+ Data.Conduit.BZlib.Internal: [c'bz_stream'bzfree] :: C'bz_stream -> Ptr ()
+ Data.Conduit.BZlib.Internal: [c'bz_stream'next_in] :: C'bz_stream -> Ptr CChar
+ Data.Conduit.BZlib.Internal: [c'bz_stream'next_out] :: C'bz_stream -> Ptr CChar
+ Data.Conduit.BZlib.Internal: [c'bz_stream'opaque] :: C'bz_stream -> Ptr ()
+ Data.Conduit.BZlib.Internal: [c'bz_stream'state] :: C'bz_stream -> Ptr ()
+ Data.Conduit.BZlib.Internal: [c'bz_stream'total_in_hi32] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: [c'bz_stream'total_in_lo32] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: [c'bz_stream'total_out_hi32] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: [c'bz_stream'total_out_lo32] :: C'bz_stream -> CUInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzCompress :: Ptr C'bz_stream -> CInt -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzCompressEnd :: Ptr C'bz_stream -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzCompressInit :: Ptr C'bz_stream -> CInt -> CInt -> CInt -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzDecompress :: Ptr C'bz_stream -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzDecompressEnd :: Ptr C'bz_stream -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ2_bzDecompressInit :: Ptr C'bz_stream -> CInt -> CInt -> IO CInt
+ Data.Conduit.BZlib.Internal: c'BZ_CONFIG_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_DATA_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_DATA_ERROR_MAGIC :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_FINISH :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_FINISH_OK :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_FLUSH :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_FLUSH_OK :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_IO_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_MEM_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_OK :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_OUTBUFF_FULL :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_PARAM_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_RUN :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_RUN_OK :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_SEQUENCE_ERROR :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_STREAM_END :: (Num a) => a
+ Data.Conduit.BZlib.Internal: c'BZ_UNEXPECTED_EOF :: (Num a) => a
+ Data.Conduit.BZlib.Internal: data C'bz_stream
+ Data.Conduit.BZlib.Internal: instance Foreign.Storable.Storable Data.Conduit.BZlib.Internal.C'bz_stream
+ Data.Conduit.BZlib.Internal: instance GHC.Classes.Eq Data.Conduit.BZlib.Internal.C'bz_stream
+ Data.Conduit.BZlib.Internal: instance GHC.Show.Show Data.Conduit.BZlib.Internal.C'bz_stream
+ Data.Conduit.BZlib.Internal: p'BZ2_bzCompress :: FunPtr (Ptr C'bz_stream -> CInt -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'BZ2_bzCompressEnd :: FunPtr (Ptr C'bz_stream -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'BZ2_bzCompressInit :: FunPtr (Ptr C'bz_stream -> CInt -> CInt -> CInt -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'BZ2_bzDecompress :: FunPtr (Ptr C'bz_stream -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'BZ2_bzDecompressEnd :: FunPtr (Ptr C'bz_stream -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'BZ2_bzDecompressInit :: FunPtr (Ptr C'bz_stream -> CInt -> CInt -> IO CInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'avail_in :: Ptr (C'bz_stream) -> Ptr (CUInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'avail_out :: Ptr (C'bz_stream) -> Ptr (CUInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'bzalloc :: Ptr (C'bz_stream) -> Ptr (Ptr ())
+ Data.Conduit.BZlib.Internal: p'bz_stream'bzfree :: Ptr (C'bz_stream) -> Ptr (Ptr ())
+ Data.Conduit.BZlib.Internal: p'bz_stream'next_in :: Ptr (C'bz_stream) -> Ptr (Ptr CChar)
+ Data.Conduit.BZlib.Internal: p'bz_stream'next_out :: Ptr (C'bz_stream) -> Ptr (Ptr CChar)
+ Data.Conduit.BZlib.Internal: p'bz_stream'opaque :: Ptr (C'bz_stream) -> Ptr (Ptr ())
+ Data.Conduit.BZlib.Internal: p'bz_stream'state :: Ptr (C'bz_stream) -> Ptr (Ptr ())
+ Data.Conduit.BZlib.Internal: p'bz_stream'total_in_hi32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'total_in_lo32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'total_out_hi32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
+ Data.Conduit.BZlib.Internal: p'bz_stream'total_out_lo32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
- Data.Conduit.BZlib: bunzip2 :: MonadResource m => Conduit ByteString m ByteString
+ Data.Conduit.BZlib: bunzip2 :: MonadResource m => ConduitT ByteString ByteString m ()
- Data.Conduit.BZlib: bzip2 :: MonadResource m => Conduit ByteString m ByteString
+ Data.Conduit.BZlib: bzip2 :: MonadResource m => ConduitT ByteString ByteString m ()
- Data.Conduit.BZlib: compress :: MonadResource m => CompressParams -> Conduit ByteString m ByteString
+ Data.Conduit.BZlib: compress :: MonadResource m => CompressParams -> ConduitT ByteString ByteString m ()
- Data.Conduit.BZlib: decompress :: MonadResource m => DecompressParams -> Conduit ByteString m ByteString
+ Data.Conduit.BZlib: decompress :: MonadResource m => DecompressParams -> ConduitT ByteString ByteString m ()
Files
- ChangeLog.md +4/−0
- Data/Conduit/BZlib.hs +0/−185
- Data/Conduit/BZlib/Internal.hsc +0/−50
- README.md +3/−0
- bench/bench.hs +2/−6
- bzlib-conduit.cabal +99/−61
- src/Data/Conduit/BZlib.hs +184/−0
- src/Data/Conduit/BZlib/Internal.hsc +50/−0
- test/test.hs +16/−15
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.3.0++* Move to conduit 1.3.0+ ## 0.2.1.5 * Remove upper bounds
− Data/Conduit/BZlib.hs
@@ -1,185 +0,0 @@-{-# LANGUAGE RecordWildCards #-} -module Data.Conduit.BZlib ( - compress, - decompress, - - bzip2, - bunzip2, - - CompressParams(..), - DecompressParams(..), - def, - ) where - -import Control.Applicative -import Control.Monad as CM -import Control.Monad.Trans -import Control.Monad.Trans.Resource -import qualified Data.ByteString as S -import qualified Data.ByteString.Unsafe as S -import Data.Conduit -import Data.Default -import Data.Maybe -import Data.IORef -import Foreign -import Foreign.C - -import Data.Conduit.BZlib.Internal - --- | Compression parameters -data CompressParams - = CompressParams - { cpBlockSize :: Int -- ^ Compress level [1..9]. default is 9. - , cpVerbosity :: Int -- ^ Verbosity mode [0..4]. default is 0. - , cpWorkFactor :: Int -- ^ Work factor [0..250]. default is 30. - } - -instance Default CompressParams where - def = CompressParams 9 0 30 - --- | Decompression parameters -data DecompressParams - = DecompressParams - { dpVerbosity :: Int -- ^ Verbosity mode [0..4]. default is 0 - , dpSmall :: Bool -- ^ If True, use an algorithm uses less memory but slow. default is False - } - -instance Default DecompressParams where - def = DecompressParams 0 False - -bufSize :: Int -bufSize = 4096 - -getAvailOut :: Ptr C'bz_stream -> IO (Maybe S.ByteString) -getAvailOut ptr = do - availOut <- liftIO $ fromIntegral <$> (peek $ p'bz_stream'avail_out ptr) - if availOut < bufSize - then do - let len = bufSize - availOut - p <- (`plusPtr` (-len)) <$> (peek $ p'bz_stream'next_out ptr) - out <- S.packCStringLen (p, fromIntegral len) - poke (p'bz_stream'next_out ptr) p - poke (p'bz_stream'avail_out ptr) (fromIntegral bufSize) - return $ Just out - else do - return Nothing - -fillInput :: Ptr C'bz_stream -> IORef (Ptr CChar, Int) -> S.ByteString -> IO () -fillInput ptr mv bs = S.unsafeUseAsCStringLen bs $ \(p, len) -> do - (buf, bsize) <- readIORef mv - let nsize = head [ s | x <- [0..], let s = bsize * 2 ^ x, s >= len ] - nbuf <- if nsize >= bsize then reallocBytes buf nsize else return buf - copyBytes nbuf p len - poke (p'bz_stream'avail_in ptr) $ fromIntegral len - poke (p'bz_stream'next_in ptr) nbuf - writeIORef mv (nbuf, nsize) - -throwIfMinus :: String -> IO CInt -> IO CInt -throwIfMinus s m = do - r <- m - when (r < 0) $ monadThrow $ userError $ s ++ ": " ++ show r - return r - -throwIfMinus_ :: String -> IO CInt -> IO () -throwIfMinus_ s m = CM.void $ throwIfMinus s m - -allocateStream :: MonadResource m => m (Ptr C'bz_stream, IORef (Ptr CChar, Int)) -allocateStream = do - (_, ptr) <- allocate malloc free - (_, inbuf) <- allocate (mallocBytes bufSize >>= \p -> newIORef (p, bufSize)) - (\mv -> readIORef mv >>= \(p, _) -> free p) - (_, outbuf) <- allocate (mallocBytes bufSize) free - liftIO $ poke ptr $ C'bz_stream - { c'bz_stream'next_in = nullPtr - , c'bz_stream'avail_in = 0 - , c'bz_stream'total_in_lo32 = 0 - , c'bz_stream'total_in_hi32 = 0 - , c'bz_stream'next_out = outbuf - , c'bz_stream'avail_out = fromIntegral bufSize - , c'bz_stream'total_out_lo32 = 0 - , c'bz_stream'total_out_hi32 = 0 - , c'bz_stream'state = nullPtr - , c'bz_stream'bzalloc = nullPtr - , c'bz_stream'bzfree = nullPtr - , c'bz_stream'opaque = nullPtr - } - return (ptr, inbuf) - --- | Compress a stream of ByteStrings. -compress - :: MonadResource m - => CompressParams -- ^ Compress parameter - -> Conduit S.ByteString m S.ByteString -compress CompressParams {..} = do - (ptr, inbuf) <- lift $ allocateStream - _ <- lift $ allocate - (throwIfMinus_ "bzCompressInit" $ - c'BZ2_bzCompressInit ptr - (fromIntegral cpBlockSize) - (fromIntegral cpVerbosity) - (fromIntegral cpWorkFactor)) - (\_ -> throwIfMinus_ "bzCompressEnd" $ c'BZ2_bzCompressEnd ptr) - - let loop = do - mbinp <- await - case mbinp of - Just inp -> do - when (not $ S.null inp) $ do - liftIO $ fillInput ptr inbuf inp - yields ptr c'BZ_RUN - loop - Nothing -> do - yields ptr c'BZ_FINISH - loop - where - yields ptr action = do - cont <- liftIO $ throwIfMinus "bzCompress" $ c'BZ2_bzCompress ptr action - mbout <- liftIO $ getAvailOut ptr - when (isJust mbout) $ - yield $ fromJust mbout - availIn <- liftIO $ fromIntegral <$> (peek $ p'bz_stream'avail_in ptr) - when (availIn > 0 || action == c'BZ_FINISH && cont /= c'BZ_STREAM_END) $ - yields ptr action - --- | Decompress a stream of ByteStrings. -decompress - :: MonadResource m - => DecompressParams -- ^ Decompress parameter - -> Conduit S.ByteString m S.ByteString -decompress DecompressParams {..} = do - (ptr, inbuf) <- lift $ allocateStream - _ <- lift $ allocate - (throwIfMinus_ "bzDecompressInit" $ - c'BZ2_bzDecompressInit ptr (fromIntegral dpVerbosity) (fromBool dpSmall)) - (\_ -> throwIfMinus_ "bzDecompressEnd" $ c'BZ2_bzDecompressEnd ptr) - - let loop = do - mbinp <- await - case mbinp of - Just inp | not (S.null inp) -> do - liftIO $ fillInput ptr inbuf inp - cont <- yields ptr - when cont $ loop - Just _ -> do - loop - Nothing -> do - lift $ monadThrow $ userError "unexpected EOF on decompress" - loop - where - yields ptr = do - ret <- liftIO $ throwIfMinus "BZ2_bzDecompress" $ c'BZ2_bzDecompress ptr - mbout <- liftIO $ getAvailOut ptr - when (isJust mbout) $ - yield $ fromJust mbout - availIn <- liftIO $ fromIntegral <$> (peek $ p'bz_stream'avail_in ptr) - if availIn > 0 - then yields ptr - else return $ ret == c'BZ_OK - --- | bzip2 compression with default parameters. -bzip2 :: MonadResource m => Conduit S.ByteString m S.ByteString -bzip2 = compress def - --- | bzip2 decompression with default parameters. -bunzip2 :: MonadResource m => Conduit S.ByteString m S.ByteString -bunzip2 = decompress def
− Data/Conduit/BZlib/Internal.hsc
@@ -1,50 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--#include <bzlib.h>-#include <bindings.dsl.h>--module Data.Conduit.BZlib.Internal where--#strict_import--#num BZ_RUN-#num BZ_FLUSH-#num BZ_FINISH--#num BZ_OK-#num BZ_RUN_OK-#num BZ_FLUSH_OK-#num BZ_FINISH_OK-#num BZ_STREAM_END-#num BZ_SEQUENCE_ERROR-#num BZ_PARAM_ERROR-#num BZ_MEM_ERROR-#num BZ_DATA_ERROR-#num BZ_DATA_ERROR_MAGIC-#num BZ_IO_ERROR-#num BZ_UNEXPECTED_EOF-#num BZ_OUTBUFF_FULL-#num BZ_CONFIG_ERROR--#starttype bz_stream-#field next_in, Ptr CChar-#field avail_in, CUInt-#field total_in_lo32, CUInt-#field total_in_hi32, CUInt-#field next_out, Ptr CChar-#field avail_out, CUInt-#field total_out_lo32, CUInt-#field total_out_hi32, CUInt-#field state, Ptr ()-#field bzalloc, Ptr ()-#field bzfree, Ptr ()-#field opaque, Ptr ()-#stoptype--#ccall BZ2_bzCompressInit, Ptr <bz_stream> -> CInt -> CInt -> CInt -> IO CInt-#ccall BZ2_bzCompress, Ptr <bz_stream> -> CInt -> IO CInt-#ccall BZ2_bzCompressEnd, Ptr <bz_stream> -> IO CInt--#ccall BZ2_bzDecompressInit, Ptr <bz_stream> -> CInt -> CInt -> IO CInt-#ccall BZ2_bzDecompress, Ptr <bz_stream> -> IO CInt-#ccall BZ2_bzDecompressEnd, Ptr <bz_stream> -> IO CInt
README.md view
@@ -1,4 +1,7 @@ bzlib-conduit ============= +[](https://travis-ci.org/snoyberg/bzlib-conduit)+[](https://ci.appveyor.com/project/snoyberg/bzlib-conduit/branch/master)+ Streaming compression/decompression via conduits.
bench/bench.hs view
@@ -1,12 +1,8 @@-import Control.Monad.Trans.Resource-import Data.Conduit-import Data.Conduit.Binary-import Data.Conduit.List as C+import Conduit import Data.Conduit.BZlib import System.Environment main :: IO () main = do [file] <- getArgs- runResourceT $ sourceFile file =$= bzip2 $$ sinkNull- -- runResourceT $ sourceFile file =$= bunzip2 $$ sinkNull+ runConduitRes $ sourceFile file .| bzip2 .| sinkNull
bzlib-conduit.cabal view
@@ -1,71 +1,109 @@-name: bzlib-conduit-version: 0.2.1.5-synopsis: Streaming compression/decompression via conduits.-description: Streaming compression/decompression via conduits.-homepage: https://github.com/snoyberg/bzlib-conduit-license: BSD3-license-file: LICENSE-author: Hideyuki Tanaka-maintainer: Michael Snoyman-copyright: (c) 2012, Hideyuki Tanaka-category: Codec-build-type: Simple-cabal-version: >=1.8-extra-source-files: README.md ChangeLog.md+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: d80abfd02a6188d89ec30ef27c527ba6c1ca1d67df4c8c118b8575dfc89fcc20 -data-files: test/*.bz2- test/*.ref+name: bzlib-conduit+version: 0.3.0+synopsis: Streaming compression/decompression via conduits.+description: Please see the README and docs at <https://www.stackage.org/package/bzlib-conduit>+category: Codec+homepage: https://github.com/snoyberg/bzlib-conduit#readme+bug-reports: https://github.com/snoyberg/bzlib-conduit/issues+author: Hideyuki Tanaka+maintainer: Michael Snoyman+copyright: (c) 2012, Hideyuki Tanaka+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10 -source-repository head- type: git- location: git://github.com/snoyberg/bzlib-conduit.git+extra-source-files:+ ChangeLog.md+ README.md -library- exposed-modules: Data.Conduit.BZlib- other-modules: Data.Conduit.BZlib.Internal+data-files:+ test/sample1.bz2+ test/sample1.ref+ test/sample2.bz2+ test/sample2.ref+ test/sample3.bz2+ test/sample3.ref - build-depends: base == 4.*- , bytestring >=0.9- , mtl >= 2.0- , conduit >= 0.5- , conduit-extra >= 1.0- , resourcet- , data-default- , bindings-DSL+source-repository head+ type: git+ location: https://github.com/snoyberg/bzlib-conduit - if !os(windows)- extra-libraries: bz2+library+ hs-source-dirs:+ src+ build-depends:+ base >=4.9 && <10+ , bindings-DSL+ , bytestring >=0.9+ , conduit >=1.3+ , data-default+ , mtl >=2.0+ , resourcet >=1.2+ if !(os(windows))+ extra-libraries:+ bz2 else- install-includes: bzlib.h, bzlib_private.h- include-dirs: cbits- c-sources: cbits/blocksort.c- cbits/huffman.c- cbits/crctable.c- cbits/randtable.c- cbits/compress.c- cbits/decompress.c- cbits/bzlib.c+ include-dirs:+ cbits+ install-includes:+ bzlib.h+ bzlib_private.h+ c-sources:+ cbits/blocksort.c+ cbits/huffman.c+ cbits/crctable.c+ cbits/randtable.c+ cbits/compress.c+ cbits/decompress.c+ cbits/bzlib.c+ exposed-modules:+ Data.Conduit.BZlib+ Data.Conduit.BZlib.Internal+ other-modules:+ Paths_bzlib_conduit+ default-language: Haskell2010 test-suite test- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: test.hs- build-depends: base == 4.*- , bytestring- , hspec >= 1.3- , QuickCheck- , random- , conduit- , conduit-extra- , bzlib-conduit- , resourcet+ type: exitcode-stdio-1.0+ main-is: test.hs+ hs-source-dirs:+ test+ build-depends:+ base >=4.9 && <10+ , bindings-DSL+ , bytestring >=0.9+ , bzlib-conduit+ , conduit >=1.3+ , data-default+ , hspec >=1.3+ , mtl >=2.0+ , random+ , resourcet >=1.2+ other-modules:+ Paths_bzlib_conduit+ default-language: Haskell2010 benchmark bench- type: exitcode-stdio-1.0- hs-source-dirs: bench- main-is: bench.hs- build-depends: base == 4.*- , conduit- , conduit-extra- , bzlib-conduit- , resourcet+ type: exitcode-stdio-1.0+ main-is: bench.hs+ hs-source-dirs:+ bench+ build-depends:+ base >=4.9 && <10+ , bindings-DSL+ , bytestring >=0.9+ , bzlib-conduit+ , conduit >=1.3+ , data-default+ , mtl >=2.0+ , resourcet >=1.2+ other-modules:+ Paths_bzlib_conduit+ default-language: Haskell2010
+ src/Data/Conduit/BZlib.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE RecordWildCards #-} +module Data.Conduit.BZlib ( + compress, + decompress, + + bzip2, + bunzip2, + + CompressParams(..), + DecompressParams(..), + def, + ) where + +import Control.Monad as CM +import Control.Monad.Trans +import Control.Monad.Trans.Resource +import qualified Data.ByteString as S +import qualified Data.ByteString.Unsafe as S +import Data.Conduit +import Data.Default +import Data.Maybe +import Data.IORef +import Foreign +import Foreign.C + +import Data.Conduit.BZlib.Internal + +-- | Compression parameters +data CompressParams + = CompressParams + { cpBlockSize :: Int -- ^ Compress level [1..9]. default is 9. + , cpVerbosity :: Int -- ^ Verbosity mode [0..4]. default is 0. + , cpWorkFactor :: Int -- ^ Work factor [0..250]. default is 30. + } + +instance Default CompressParams where + def = CompressParams 9 0 30 + +-- | Decompression parameters +data DecompressParams + = DecompressParams + { dpVerbosity :: Int -- ^ Verbosity mode [0..4]. default is 0 + , dpSmall :: Bool -- ^ If True, use an algorithm uses less memory but slow. default is False + } + +instance Default DecompressParams where + def = DecompressParams 0 False + +bufSize :: Int +bufSize = 4096 + +getAvailOut :: Ptr C'bz_stream -> IO (Maybe S.ByteString) +getAvailOut ptr = do + availOut <- liftIO $ fromIntegral <$> (peek $ p'bz_stream'avail_out ptr) + if availOut < bufSize + then do + let len = bufSize - availOut + p <- (`plusPtr` (-len)) <$> (peek $ p'bz_stream'next_out ptr) + out <- S.packCStringLen (p, fromIntegral len) + poke (p'bz_stream'next_out ptr) p + poke (p'bz_stream'avail_out ptr) (fromIntegral bufSize) + return $ Just out + else do + return Nothing + +fillInput :: Ptr C'bz_stream -> IORef (Ptr CChar, Int) -> S.ByteString -> IO () +fillInput ptr mv bs = S.unsafeUseAsCStringLen bs $ \(p, len) -> do + (buf, bsize) <- readIORef mv + let nsize = head [ s | x <- [0..], let s = bsize * 2 ^ (x :: Int), s >= len ] + nbuf <- if nsize >= bsize then reallocBytes buf nsize else return buf + copyBytes nbuf p len + poke (p'bz_stream'avail_in ptr) $ fromIntegral len + poke (p'bz_stream'next_in ptr) nbuf + writeIORef mv (nbuf, nsize) + +throwIfMinus :: String -> IO CInt -> IO CInt +throwIfMinus s m = do + r <- m + when (r < 0) $ throwM $ userError $ s ++ ": " ++ show r + return r + +throwIfMinus_ :: String -> IO CInt -> IO () +throwIfMinus_ s m = CM.void $ throwIfMinus s m + +allocateStream :: MonadResource m => m (Ptr C'bz_stream, IORef (Ptr CChar, Int)) +allocateStream = do + (_, ptr) <- allocate malloc free + (_, inbuf) <- allocate (mallocBytes bufSize >>= \p -> newIORef (p, bufSize)) + (\mv -> readIORef mv >>= \(p, _) -> free p) + (_, outbuf) <- allocate (mallocBytes bufSize) free + liftIO $ poke ptr $ C'bz_stream + { c'bz_stream'next_in = nullPtr + , c'bz_stream'avail_in = 0 + , c'bz_stream'total_in_lo32 = 0 + , c'bz_stream'total_in_hi32 = 0 + , c'bz_stream'next_out = outbuf + , c'bz_stream'avail_out = fromIntegral bufSize + , c'bz_stream'total_out_lo32 = 0 + , c'bz_stream'total_out_hi32 = 0 + , c'bz_stream'state = nullPtr + , c'bz_stream'bzalloc = nullPtr + , c'bz_stream'bzfree = nullPtr + , c'bz_stream'opaque = nullPtr + } + return (ptr, inbuf) + +-- | Compress a stream of ByteStrings. +compress + :: MonadResource m + => CompressParams -- ^ Compress parameter + -> ConduitT S.ByteString S.ByteString m () +compress CompressParams {..} = do + (ptr, inbuf) <- lift $ allocateStream + _ <- lift $ allocate + (throwIfMinus_ "bzCompressInit" $ + c'BZ2_bzCompressInit ptr + (fromIntegral cpBlockSize) + (fromIntegral cpVerbosity) + (fromIntegral cpWorkFactor)) + (\_ -> throwIfMinus_ "bzCompressEnd" $ c'BZ2_bzCompressEnd ptr) + + let loop = do + mbinp <- await + case mbinp of + Just inp -> do + when (not $ S.null inp) $ do + liftIO $ fillInput ptr inbuf inp + yields ptr c'BZ_RUN + loop + Nothing -> do + yields ptr c'BZ_FINISH + loop + where + yields ptr action = do + cont <- liftIO $ throwIfMinus "bzCompress" $ c'BZ2_bzCompress ptr action + mbout <- liftIO $ getAvailOut ptr + when (isJust mbout) $ + yield $ fromJust mbout + availIn <- liftIO $ peek $ p'bz_stream'avail_in ptr + when (availIn > 0 || action == c'BZ_FINISH && cont /= c'BZ_STREAM_END) $ + yields ptr action + +-- | Decompress a stream of ByteStrings. +decompress + :: MonadResource m + => DecompressParams -- ^ Decompress parameter + -> ConduitT S.ByteString S.ByteString m () +decompress DecompressParams {..} = do + (ptr, inbuf) <- lift $ allocateStream + _ <- lift $ allocate + (throwIfMinus_ "bzDecompressInit" $ + c'BZ2_bzDecompressInit ptr (fromIntegral dpVerbosity) (fromBool dpSmall)) + (\_ -> throwIfMinus_ "bzDecompressEnd" $ c'BZ2_bzDecompressEnd ptr) + + let loop = do + mbinp <- await + case mbinp of + Just inp | not (S.null inp) -> do + liftIO $ fillInput ptr inbuf inp + cont <- yields ptr + when cont $ loop + Just _ -> do + loop + Nothing -> do + liftIO $ throwM $ userError "unexpected EOF on decompress" + loop + where + yields ptr = do + ret <- liftIO $ throwIfMinus "BZ2_bzDecompress" $ c'BZ2_bzDecompress ptr + mbout <- liftIO $ getAvailOut ptr + when (isJust mbout) $ + yield $ fromJust mbout + availIn <- liftIO $ peek $ p'bz_stream'avail_in ptr + if availIn > 0 + then yields ptr + else return $ ret == c'BZ_OK + +-- | bzip2 compression with default parameters. +bzip2 :: MonadResource m => ConduitT S.ByteString S.ByteString m () +bzip2 = compress def + +-- | bzip2 decompression with default parameters. +bunzip2 :: MonadResource m => ConduitT S.ByteString S.ByteString m () +bunzip2 = decompress def
+ src/Data/Conduit/BZlib/Internal.hsc view
@@ -0,0 +1,50 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#include <bzlib.h>+#include <bindings.dsl.h>++module Data.Conduit.BZlib.Internal where++#strict_import++#num BZ_RUN+#num BZ_FLUSH+#num BZ_FINISH++#num BZ_OK+#num BZ_RUN_OK+#num BZ_FLUSH_OK+#num BZ_FINISH_OK+#num BZ_STREAM_END+#num BZ_SEQUENCE_ERROR+#num BZ_PARAM_ERROR+#num BZ_MEM_ERROR+#num BZ_DATA_ERROR+#num BZ_DATA_ERROR_MAGIC+#num BZ_IO_ERROR+#num BZ_UNEXPECTED_EOF+#num BZ_OUTBUFF_FULL+#num BZ_CONFIG_ERROR++#starttype bz_stream+#field next_in, Ptr CChar+#field avail_in, CUInt+#field total_in_lo32, CUInt+#field total_in_hi32, CUInt+#field next_out, Ptr CChar+#field avail_out, CUInt+#field total_out_lo32, CUInt+#field total_out_hi32, CUInt+#field state, Ptr ()+#field bzalloc, Ptr ()+#field bzfree, Ptr ()+#field opaque, Ptr ()+#stoptype++#ccall BZ2_bzCompressInit, Ptr <bz_stream> -> CInt -> CInt -> CInt -> IO CInt+#ccall BZ2_bzCompress, Ptr <bz_stream> -> CInt -> IO CInt+#ccall BZ2_bzCompressEnd, Ptr <bz_stream> -> IO CInt++#ccall BZ2_bzDecompressInit, Ptr <bz_stream> -> CInt -> CInt -> IO CInt+#ccall BZ2_bzDecompress, Ptr <bz_stream> -> IO CInt+#ccall BZ2_bzDecompressEnd, Ptr <bz_stream> -> IO CInt
test/test.hs view
@@ -1,19 +1,14 @@ {-# LANGUAGE ViewPatterns #-} import Control.Applicative -import Control.Monad -import Control.Monad.Trans.Resource (runResourceT) +import Control.Monad (replicateM, forM_) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L -import Data.Conduit -import Data.Conduit.Binary as B +import Conduit import Data.Conduit.BZlib -import Data.Conduit.List as C import System.Random import Test.Hspec import Test.Hspec.QuickCheck -import Test.QuickCheck -import Test.QuickCheck.Property import Prelude as P @@ -22,19 +17,25 @@ describe "decompress" $ do forM_ ["sample1", "sample2", "sample3"] $ \file -> do it ("correctly " ++ file ++ ".bz2") $ do - dec <- runResourceT $ do - sourceFile ("test/" ++ file ++ ".bz2") =$= bunzip2 $$ B.take (10^9) + dec <- runConduitRes + $ sourceFile ("test/" ++ file ++ ".bz2") + .| bunzip2 + .| takeCE 1000000000 + .| sinkLazy ref <- L.readFile ("test/" ++ file ++ ".ref") dec `shouldBe` ref describe "compress" $ do - prop ". decompress == id" $ \((`mod` (2^16)) . abs -> n) -> do - morallyDubiousIOProperty $ do + prop ". decompress == id" $ \((`mod` (2^(16 :: Int))) . abs -> n) -> do let bsize = 8192 ss <- P.takeWhile (not. null) . P.map (P.take bsize) . P.iterate (P.drop bsize) - <$> Control.Monad.replicateM (abs n) randomIO - dest <- runResourceT $ do - C.sourceList (P.map S.pack ss) =$= bzip2 =$= bunzip2 $$ B.take (10^9) - return $ dest == L.pack (P.concat ss) + <$> replicateM (abs n) randomIO + dest <- runConduitRes + $ yieldMany (P.map S.pack ss) + .| bzip2 + .| bunzip2 + .| takeCE 1000000000 + .| sinkLazy + dest `shouldBe` L.pack (P.concat ss)