packages feed

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 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 ============= +[![Build Status](https://travis-ci.org/snoyberg/bzlib-conduit.svg?branch=master)](https://travis-ci.org/snoyberg/bzlib-conduit)+[![Build status](https://ci.appveyor.com/api/projects/status/36ahru3rr7uiedt4/branch/master?svg=true)](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)