Compare against alternative implementation using lists

test.hs

@@ -36,17 +36,19 @@ import qualified Data.Enumerator.List as EL
 import qualified Data.Enumerator.Text as ET
 import qualified Data.Enumerator.Binary as EB
 
+import Control.Monad (foldM)
+import Control.Monad.Trans (MonadIO (..), liftIO, lift)
 import Control.Exception (bracket)
-import Control.Monad.Trans (MonadIO (..), liftIO)
 
-import Codec.Zlib (WindowBits (..))
+import Codec.Zlib
 import qualified Codec.Zlib.Enum as Z
 
 import Test.QuickCheck
 import Test.QuickCheck.Monadic
 import qualified Test.QuickCheck.Monadic as Q
 
 import System.IO (IOMode (..), openFile, hClose)
+import System.IO.Unsafe (unsafePerformIO)
 
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -87,6 +89,34 @@ unconsumed = E.sequence $ do
   xs <- EB.take 100
   return $ B.concat $ L.toChunks xs
 
+-- | Concatenate an Iteratee and a list of Enumeratees into an Iteratee.
+concatWith :: Monad m => Iteratee a m b -> [Enumeratee a a m b] -> Iteratee a m b
+concatWith = foldr f
+  where
+  f iter enums = joinI $ iter $$ enums
+
+-- | Compress a list of ByteStrings
+compress
+  :: MonadIO m
+  => WindowBits
+  -> [ByteString]
+  -> m ByteString
+compress win xs =
+  E.run_ $  E.enumList 1 xs
+         $$ joinI $ Z.compress 7 win
+         $$ consume
+
+-- | Decompress a list of ByteStrings
+decompress
+  :: MonadIO m
+  => WindowBits
+  -> [ByteString]
+  -> m ByteString
+decompress win xs =
+  E.run_ $  E.enumList 1 xs
+         $$ joinI $ Z.decompress win
+         $$ consume
+
 -- | Compress and decompress without doing anything else.
 compressDecompress
   :: MonadIO m
@@ -114,30 +144,19 @@ compressDecompressWith enum win xs =
          $$ joinI $ Z.decompress win
          $$ consume
 
--- | Compress a ByteString multiple times and then decompress it the
--- same number of times
+-- | Compress a ByteString 'n' times and then decompress it 'n' times
 compressDecompressMany
   :: MonadIO m
   => WindowBits
+  -> Int
   -> [ByteString]
   -> m ByteString
-compressDecompressMany win xs =
+compressDecompressMany win n xs =
   E.run_ $  E.enumList 1 xs
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.compress 7 win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ joinI $ Z.decompress win
-         $$ consume
+         $$ concatWith consume es
+  where
+  es = replicate m (Z.compress 7 win) ++ replicate m (Z.decompress win)
+  m = 1 + (abs n `rem` 10) -- restrict n to [1, 10]
 
 -- | Compress a [ByteString] to a file with an Enumeratee
 compressFileWith
@@ -162,35 +181,95 @@ decompressFileWith enum win file =
        $$ joinI $ enum
        $$ consume
 
+-- | Alternative implementation of compress for comparison
+compressChunks :: WindowBits -> [ByteString] -> IO [ByteString]
+compressChunks win xs = do
+    def <- initDeflate 7 win
+    gziped <- foldM (go' def) id xs
+    gziped' <- finishDeflate def $ go gziped
+    return $ gziped' []
+  where
+    go' def front bs = withDeflateInput def bs $ go front
+    go front x = do
+        y <- x
+        case y of
+            Nothing -> return front
+            Just z -> go (front . (:) z) x
+
+-- | Alternative implementation of decompress for comparison
+decompressChunks :: WindowBits -> [ByteString] -> IO [ByteString]
+decompressChunks win xs = do
+    inf <- initInflate win
+    ungziped <- foldM (go' inf) id xs
+    final <- finishInflate inf
+    return $ ungziped [final]
+  where
+    go' inf front bs = withInflateInput inf bs $ go front
+    go front x = do
+        y <- x
+        case y of
+            Nothing -> return front
+            Just z -> go (front . (:) z) x
+
 -------------------------------------------------------------------------------
 -- Properties
 -------------------------------------------------------------------------------
 
+-- | Compare compresssion via lists and enumerator
+prop_compress_compare :: WindowBits -> [ByteString] -> Property
+prop_compress_compare win xs = monadicIO $ do
+  chks <- Q.run $ B.concat `fmap` compressChunks win xs
+  enum <- Q.run $ compress win xs
+  assert $ enum == chks
+
+-- | Compare decompression via lists and enumerator
+prop_decompress_compare :: WindowBits -> [ByteString] -> Property
+prop_decompress_compare win xs = monadicIO $ do
+  comp <- Q.run $ compressChunks win xs
+  chks <- Q.run $ B.concat `fmap` decompressChunks win comp
+  enum <- Q.run $ decompress win comp
+  assert $ enum == chks
+
+-- | Check: bs == decompress (compress bs)
+-- (That is, in separate Enumeratees)
 prop_compress_decompress :: WindowBits -> [ByteString] -> Property
 prop_compress_decompress win xs = monadicIO $ do
+  cs <- Q.run $ compress win xs
+  ys <- Q.run $ decompress win [cs]
+  assert (B.concat xs == ys)
+
+-- | Check: bs == compressDecompress bs
+-- (That is, in a single Enumeratee)
+prop_compress_decompress' :: WindowBits -> [ByteString] -> Property
+prop_compress_decompress' win xs = monadicIO $ do
   ys <- Q.run $ compressDecompress win xs
   assert (B.concat xs == ys)
 
+-- | Check if using an Iteratee that consumes only a few bytes works
 prop_unconsumed :: WindowBits -> [ByteString] -> Property
 prop_unconsumed win xs = monadicIO $ do
   ys <- Q.run $ compressDecompressWith unconsumed win xs
   assert (B.concat xs == ys)
 
+-- | Check if mapping the identity function doesn't affect anything
 prop_map_id :: WindowBits -> [ByteString] -> Property
 prop_map_id win xs = monadicIO $ do
   ys <- Q.run $ compressDecompressWith (E.map id) win xs
   assert (B.concat xs == ys)
 
+-- | Check if mapping 'reverse . reverse' doesn't affect anything
 prop_map_revrev :: WindowBits -> [ByteString] -> Property
 prop_map_revrev win xs = monadicIO $ do
   ys <- Q.run $ compressDecompressWith (E.map $ B.reverse . B.reverse) win xs
   assert (B.concat xs == ys)
 
-prop_many :: WindowBits -> [ByteString] -> Property
-prop_many win xs = monadicIO $ do
-  ys <- Q.run $ compressDecompressMany win xs
+-- | Check if compressing and decompressing multiple times works
+prop_many :: WindowBits -> Int -> [ByteString] -> Property
+prop_many win n xs = monadicIO $ do
+  ys <- Q.run $ compressDecompressMany win n xs
   assert (B.concat xs == ys)
 
+-- | Check compressing and decompresssing a file
 prop_files_map_id :: FilePath -> WindowBits -> [ByteString] -> Property
 prop_files_map_id file win xs = monadicIO $ do
   Q.run $ compressFileWith enum win file xs
@@ -199,6 +278,8 @@ prop_files_map_id file win xs = monadicIO $ do
   where
   enum = E.map id
 
+-- | Check compressing and decompressing a file with an Iteratee that
+-- consumes only a few bytes
 prop_files_unconsumed :: FilePath -> WindowBits -> [ByteString] -> Property
 prop_files_unconsumed file win xs = monadicIO $ do
   Q.run $ compressFileWith unconsumed win file xs
@@ -211,12 +292,17 @@ prop_files_unconsumed file win xs = monadicIO $ do
 
 tests :: [Test]
 tests = let testFile = "zlib-enum-test-file" in
-  [ testGroup "enumList"
+  [ testGroup "compare"
+    [ testProperty "compress_compressChunks" prop_compress_compare
+    , testProperty "decompress_decompressChunks" prop_decompress_compare
+    ]
+  , testGroup "enumList"
     [ testProperty "compress_decompress" prop_compress_decompress
+    , testProperty "compress_decompress'" prop_compress_decompress'
     , testProperty "unconsumed" prop_unconsumed
     , testProperty "map_id" prop_map_id
     , testProperty "map_revrev" prop_map_revrev
-    -- , testProperty "many" prop_many
+    , testProperty "many" prop_many
     ]
   , testGroup "enumFile"
     [ testProperty "files_map_id" (prop_files_map_id testFile)

zlib-enum.cabal

@@ -35,15 +35,16 @@ executable zlib-enum-test
     main-is: test.hs
     if flag(test)
         Buildable: True
-        build-depends: base                  >= 4.0   &&   < 5.0
-                     , bytestring            >= 0.9   &&   < 0.10
-                     , mtl                   >= 2.0   &&   < 2.1
-                     , enumerator            >= 0.4   &&   < 0.5
-                     , zlib-bindings         >= 0.0   &&   < 0.1
-                     , process               >= 1.0   &&   < 1.1
-                     , test-framework        >= 0.3   &&   < 0.4
-                     , test-framework-quickcheck2 >= 0.2.9  &&   < 0.3.0
-                     , QuickCheck            >= 2.4   &&   < 2.5
+        build-depends:
+              base                       >= 4.0   &&   < 5.0
+            , bytestring                 >= 0.9   &&   < 0.10
+            , mtl                        >= 2.0   &&   < 2.1
+            , enumerator                 >= 0.4   &&   < 0.5
+            , zlib-bindings              >= 0.0   &&   < 0.1
+            , process                    >= 1.0   &&   < 1.1
+            , test-framework             >= 0.3   &&   < 0.4
+            , test-framework-quickcheck2 >= 0.2.9 &&   < 0.3.0
+            , QuickCheck                 >= 2.4   &&   < 2.5
     else
         Buildable: False
     ghc-options:     -Wall