diff --git a/Codec/Zlib/Enum.hs b/Codec/Zlib/Enum.hs --- a/Codec/Zlib/Enum.hs +++ b/Codec/Zlib/Enum.hs @@ -1,80 +1,81 @@ module Codec.Zlib.Enum ( -- * Enumeratees - compress, decompress, - -- * Re-exported from zlib-bindings - WindowBits, defaultWindowBits + compress, decompress, gzip, ungzip, + -- * Re-exported from zlib-bindings + WindowBits (..), defaultWindowBits ) where import Codec.Zlib import Data.Enumerator as E -import Control.Monad.Trans (MonadIO, liftIO) +import qualified Data.Enumerator.List as EL +import Control.Monad.Trans.Class (lift) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) -import Control.Monad (join) -joinIO :: MonadIO m => IO (m (Step a m b)) -> Iteratee a m b -joinIO = Iteratee . join . liftIO +-- | Gzip compression with default parameters. +gzip :: MonadIO m => Enumeratee ByteString ByteString m a +gzip = compress 1 defaultWindowBits -enumLoop :: Monad m => - ((Stream b -> Iteratee b m c) -> Iteratee b m c) - -> (a -> (Stream b -> Iteratee b m c) -> Iteratee b m c) - -> Enumeratee a b m c -enumLoop done more = checkDone loop where - loop k = do maybe_x <- E.head - case maybe_x of - Nothing -> return $$ done k - Just x -> checkDone loop $$ more x k +-- | Gzip decompression with default parameters. +ungzip :: MonadIO m => Enumeratee ByteString ByteString m a +ungzip = decompress defaultWindowBits -- | -- Decompress (inflate) a stream of 'ByteString's. For example: --- +-- -- > run $ enumFile "test.z" $$ decompress defaultWindowBits $$ printChunks True -decompress :: MonadIO m +decompress + :: MonadIO m => WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Enumeratee ByteString ByteString m a -decompress config step0 = do - inflate <- liftIO $ initInflate config - let done k = do lastChunk <- liftIO $ finishInflate inflate - k (Chunks [lastChunk]) - more x k = joinIO $ withInflateInput inflate x (return . callback k) - enumLoop done more step0 +decompress config inner = do + inf <- liftIO $ initInflate config + decompress' inf inner +decompress' :: MonadIO m => Inflate -> Enumeratee ByteString ByteString m b +decompress' inf (Continue k) = do + x <- EL.head + case x of + Nothing -> do + chunk <- liftIO $ finishInflate inf + lift $ runIteratee $ k $ Chunks [chunk] + Just bs -> do + chunks <- liftIO $ withInflateInput inf bs $ callback + step <- lift $ runIteratee $ k $ Chunks chunks + decompress' inf step +decompress' _ step = return step + -- | -- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control -- the format (zlib vs. gzip). -compress :: MonadIO m - => Int -- ^ Compression level - -> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) +compress + :: MonadIO m + => Int -- ^ Compression level + -> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library) -> Enumeratee ByteString ByteString m a -compress level config step0 = do - deflate <- liftIO $ initDeflate level config - let done k = joinIO $ finishDeflate deflate (return . callback k) - more x k = joinIO $ withDeflateInput deflate x (return . callback k) - enumLoop done more step0 - --- A callback function for withInflateInput / withDeflateInput -callback :: MonadIO m => - (Stream a -> Iteratee a m b) -> IO (Maybe a) -> m (Step a m b) +compress level config inner = do + def <- liftIO $ initDeflate level config + compress' def inner -callback k pop = maybe done more =<< liftIO pop - where - done = return (Continue k) - more y = do step <- runIteratee (k (Chunks [y])) - case step of - Continue k' -> callback k' pop - other -> return other +compress' :: MonadIO m => Deflate -> Enumeratee ByteString ByteString m b +compress' def (Continue k) = do + x <- EL.head + case x of + Nothing -> do + chunks <- liftIO $ finishDeflate def $ callback + lift $ runIteratee $ k $ Chunks chunks + Just bs -> do + chunks <- liftIO $ withDeflateInput def bs $ callback + step <- lift $ runIteratee $ k $ Chunks chunks + compress' def step +compress' _ step = return step --- testInflate = do --- h <- openBinaryFile "test-out" WriteMode --- run $ enumFile "test.z" --- $$ decompress defaultWindowBits --- $$ iterHandle h --- hClose h --- --- testDeflate = do --- h <- openBinaryFile "test.z" WriteMode --- run $ enumFile "test" --- $$ compress 7 defaultWindowBits --- $$ iterHandle h --- hClose h +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) diff --git a/test.hs b/test.hs new file mode 100644 --- /dev/null +++ b/test.hs @@ -0,0 +1,331 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +------------------------------------------------------------------------------- +-- | +-- Module : zlib-enum-test +-- Copyright : (c) 2011 Malte Sommerkorn, Michael Snoyman, Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Malte Sommerkorn +-- +------------------------------------------------------------------------------- + +module Main where + +------------------------------------------------------------------------------- +-- Imports +------------------------------------------------------------------------------- + +import Prelude + +import Data.String () + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import Data.Enumerator + ( Iteratee (..), Enumeratee + , ($$), joinI, run_ ) +import qualified Data.Enumerator as E +import qualified Data.Enumerator.List as EL +import qualified Data.Enumerator.Binary as EB + +import Control.Monad (foldM) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Exception (bracket) + +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 (..), openBinaryFile, hClose) + +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +-- | QuickCheck wants a Show instance for WindowBits +instance Show WindowBits where + show (WindowBits n) = "WindowBits " ++ show n + show _ = "DefaultWindowBits" -- not exported from zlib + +-- | Random values for WindowBits: 15 or 31 +instance Arbitrary WindowBits where + arbitrary = elements [WindowBits 15, WindowBits 31] + +-- | Generate relatively large ByteStrings +instance Arbitrary B.ByteString where + arbitrary = (B.pack . concat . replicate 1000) `fmap` arbitrary + +-- | Generate relatively large Lazy ByteStrings +instance Arbitrary L.ByteString where + arbitrary = (L.fromChunks . concat . replicate 100) `fmap` arbitrary + +------------------------------------------------------------------------------- +-- Utility Functions +------------------------------------------------------------------------------- + +-- | Iteratee that consumes the entire Stream as a strict ByteString. +consume :: Monad m => Iteratee ByteString m ByteString +consume = do + xs <- EL.consume + return $ B.concat xs + +-- | Enumeratee that consumes only a few bytes. +unconsumed :: Monad m => Enumeratee ByteString ByteString m a +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 + => WindowBits + -> [ByteString] + -> m ByteString +compressDecompress win xs = + E.run_ $ E.enumList 1 xs + $$ joinI $ Z.compress 7 win + $$ joinI $ Z.decompress win + $$ consume + +-- | The same, but for 'gzip', 'ungzip' +gzipUngzip :: MonadIO m => [ByteString] -> m ByteString +gzipUngzip xs = + E.run_ $ E.enumList 1 xs + $$ joinI $ Z.gzip + $$ joinI $ Z.ungzip + $$ consume + +-- | Compress and decompress a ByteString with given WindowBits, +-- piping the stream with an Enumeratee. +compressDecompressWith + :: MonadIO m + => Enumeratee ByteString ByteString m ByteString + -> WindowBits + -> [ByteString] + -> m ByteString +compressDecompressWith enum win xs = + E.run_ $ E.enumList 1 xs + $$ joinI $ Z.compress 7 win + $$ joinI $ enum + $$ joinI $ Z.decompress win + $$ consume + +-- | Compress a ByteString 'n' times and then decompress it 'n' times +compressDecompressMany + :: MonadIO m + => WindowBits + -> Int + -> [ByteString] + -> m ByteString +compressDecompressMany win n xs = + E.run_ $ E.enumList 1 xs + $$ 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 + :: Enumeratee ByteString ByteString IO () + -> WindowBits -> FilePath -> [ByteString] -> IO () +compressFileWith enum win file xs = bracket + (openBinaryFile file WriteMode) + (hClose) + $ \ h -> do + run_ $ E.enumList 1 xs + $$ joinI $ Z.compress 7 win + $$ joinI $ enum + $$ EB.iterHandle h + +-- | Decompress from a file with an Enumeratee +decompressFileWith + :: Enumeratee ByteString ByteString IO ByteString + -> WindowBits -> FilePath -> IO ByteString +decompressFileWith enum win file = + run_ $ EB.enumFile file + $$ joinI $ Z.decompress win + $$ 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, with 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, with 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: bs == gzipUngzip bs +-- (just to see if the default parameters aren't broken) +prop_gzip_ungzip :: [ByteString] -> Property +prop_gzip_ungzip xs = monadicIO $ do + ys <- Q.run $ gzipUngzip 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) + +-- | 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 decompressing 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 + ys <- Q.run $ decompressFileWith enum win file + assert (B.concat xs == ys) + 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 + ys <- Q.run $ decompressFileWith unconsumed win file + assert (B.concat xs == ys) + +------------------------------------------------------------------------------- +-- Tests +------------------------------------------------------------------------------- + +tests :: [Test] +tests = let testFile = "zlib-enum-test-file" in + [ 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 "gzip_ungzip" prop_gzip_ungzip + , testProperty "unconsumed" prop_unconsumed + , testProperty "map_id" prop_map_id + , testProperty "map_revrev" prop_map_revrev + , testProperty "many" prop_many + ] + , testGroup "enumFile" + [ testProperty "files_map_id" (prop_files_map_id testFile) + , testProperty "files_unconsumed" (prop_files_unconsumed testFile) + ] + ] + +------------------------------------------------------------------------------- +-- IO +------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain tests diff --git a/zlib-enum.cabal b/zlib-enum.cabal --- a/zlib-enum.cabal +++ b/zlib-enum.cabal @@ -1,8 +1,8 @@ name: zlib-enum -version: 0.1 +version: 0.2 license: MIT license-file: LICENSE -author: Malte Sommerkorn +author: Paulo Tanimoto maintainer: Malte Sommerkorn synopsis: Enumerator interface for zlib compression description: zlib-enum is a stop-gap package to provide enumeratees for @@ -13,15 +13,43 @@ build-type: Simple homepage: http://github.com/maltem/zlib-enum +------------------------------------------------------------------------------- +flag test + description: Build the test executable. + default: False + +------------------------------------------------------------------------------- library + if flag(test) + Buildable: False build-depends: base >= 4 && < 5 , bytestring - , mtl >= 2 + , transformers == 0.2.* , enumerator >= 0.4 , zlib-bindings exposed-modules: Codec.Zlib.Enum ghc-options: -Wall +------------------------------------------------------------------------------- +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 + , transformers == 0.2.* + , 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 + +------------------------------------------------------------------------------- source-repository head type: git location: git://github.com/maltem/zlib-enum.git