Implementation of 'compress' based on Michael's 'decompress'

Codec/Zlib/Enum.hs

@@ -11,6 +11,7 @@ import Control.Monad.Trans (MonadIO, liftIO, lift)
 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
 
@@ -23,6 +24,7 @@ enumLoop done more = checkDone loop where
                 case maybe_x of
                      Nothing -> return $$ done k
                      Just x  -> checkDone loop $$ more x k
+--}
 
 -- |
 -- Decompress (inflate) a stream of 'ByteString's. For example:
@@ -33,20 +35,20 @@ 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 inner = do
-    fzstr <- liftIO $ initInflate config
-    decompress' fzstr inner
+    inf <- liftIO $ initInflate config
+    decompress' inf inner
 
 decompress' :: MonadIO m => Inflate -> Enumeratee ByteString ByteString m b
-decompress' fzstr (Continue k) = do
+decompress' inf (Continue k) = do
     x <- E.head
     case x of
         Nothing -> do
-            chunk <- liftIO $ finishInflate fzstr
+            chunk <- liftIO $ finishInflate inf
             lift $ runIteratee $ k $ Chunks [chunk]
         Just bs -> do
-            chunks <- liftIO $ withInflateInput fzstr bs $ go id
+            chunks <- liftIO $ withInflateInput inf bs $ go id
             step <- lift $ runIteratee $ k $ Chunks chunks
-            decompress' fzstr step
+            decompress' inf step
   where
     go front pop = do
         x <- pop
@@ -59,6 +61,35 @@ decompress' _ step = return step
 -- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control
 -- the format (zlib vs. gzip).
 
+compress
+    :: MonadIO m
+    => Int
+    -> WindowBits
+    -> Enumeratee ByteString ByteString m a
+compress level config inner = do
+    def <- liftIO $ initDeflate level config
+    compress' def inner
+
+compress' :: MonadIO m => Deflate -> Enumeratee ByteString ByteString m b
+compress' def (Continue k) = do
+    x <- E.head
+    case x of
+        Nothing -> do
+            chunks <- liftIO $ finishDeflate def $ go id
+            lift $ runIteratee $ k $ Chunks chunks
+        Just bs -> do
+            chunks <- liftIO $ withDeflateInput def bs $ go id
+            step <- lift $ runIteratee $ k $ Chunks chunks
+            compress' def step
+  where
+    go front pop = do
+        x <- pop
+        case x of
+            Nothing -> return $ front []
+            Just y -> go (front . (:) y) pop
+compress' _ step = return step
+
+{--
 compress :: MonadIO m
     => Int        -- ^ Compression level
     -> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
@@ -80,6 +111,7 @@ callback k pop = runIteratee . k . Chunks =<< liftIO (go id)
     case x of
       Nothing -> return $ front []
       Just y  -> go (front . (:) y)
+--}
 
 -- testInflate = do
 --     h <- openBinaryFile "test-out" WriteMode