diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.3.0 + +* Move to conduit 1.3.0 + ## 0.2.1.5 * Remove upper bounds diff --git a/Data/Conduit/BZlib.hs b/Data/Conduit/BZlib.hs deleted file mode 100644 --- a/Data/Conduit/BZlib.hs +++ /dev/null @@ -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 diff --git a/Data/Conduit/BZlib/Internal.hsc b/Data/Conduit/BZlib/Internal.hsc deleted file mode 100644 --- a/Data/Conduit/BZlib/Internal.hsc +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -#include -#include - -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 -> CInt -> CInt -> CInt -> IO CInt -#ccall BZ2_bzCompress, Ptr -> CInt -> IO CInt -#ccall BZ2_bzCompressEnd, Ptr -> IO CInt - -#ccall BZ2_bzDecompressInit, Ptr -> CInt -> CInt -> IO CInt -#ccall BZ2_bzDecompress, Ptr -> IO CInt -#ccall BZ2_bzDecompressEnd, Ptr -> IO CInt diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/bench/bench.hs b/bench/bench.hs --- a/bench/bench.hs +++ b/bench/bench.hs @@ -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 diff --git a/bzlib-conduit.cabal b/bzlib-conduit.cabal --- a/bzlib-conduit.cabal +++ b/bzlib-conduit.cabal @@ -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 +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 diff --git a/src/Data/Conduit/BZlib.hs b/src/Data/Conduit/BZlib.hs new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/BZlib.hs @@ -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 diff --git a/src/Data/Conduit/BZlib/Internal.hsc b/src/Data/Conduit/BZlib/Internal.hsc new file mode 100644 --- /dev/null +++ b/src/Data/Conduit/BZlib/Internal.hsc @@ -0,0 +1,50 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +#include +#include + +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 -> CInt -> CInt -> CInt -> IO CInt +#ccall BZ2_bzCompress, Ptr -> CInt -> IO CInt +#ccall BZ2_bzCompressEnd, Ptr -> IO CInt + +#ccall BZ2_bzDecompressInit, Ptr -> CInt -> CInt -> IO CInt +#ccall BZ2_bzDecompress, Ptr -> IO CInt +#ccall BZ2_bzDecompressEnd, Ptr -> IO CInt diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -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)