Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Flushing (#2)

  • Loading branch information...
commit 3a4bc720c5bd694baf4a346a3369d62335e46c7c 1 parent 52eb4de
Michael Snoyman authored
25 Codec/Zlib.hs
View
@@ -25,12 +25,14 @@ module Codec.Zlib
, initInflateWithDictionary
, withInflateInput
, finishInflate
+ , flushInflate
-- * Deflate
, Deflate
, initDeflate
, initDeflateWithDictionary
, withDeflateInput
, finishDeflate
+ , flushDeflate
-- * Data types
, WindowBits (WindowBits)
, defaultWindowBits
@@ -214,7 +216,19 @@ finishInflate (Inflate ((fzstr, fbuff), _)) =
withForeignPtr fbuff $ \buff -> do
avail <- c_get_avail_out zstr
let size = defaultChunkSize - fromIntegral avail
- S.packCStringLen (buff, size)
+ bs <- S.packCStringLen (buff, size)
+ c_set_avail_out zstr buff
+ $ fromIntegral defaultChunkSize
+ return bs
+
+-- | Flush the inflation buffer. Useful for interactive application.
+--
+-- This is actually a synonym for 'finishInflate'. It is provided for its more
+-- semantic name.
+--
+-- Since 0.0.3
+flushInflate :: Inflate -> IO S.ByteString
+flushInflate = finishInflate
-- | Feed the given 'S.ByteString' to the deflater. This function takes a
-- function argument which takes a \"popper\". A popper is an IO action that
@@ -244,3 +258,12 @@ finishDeflate (Deflate (fzstr, fbuff)) f =
withForeignPtr fzstr $ \zstr ->
f $ drain fbuff zstr c_call_deflate_finish True
+-- | Flush the deflation buffer. Useful for interactive application.
+--
+-- Internally this passes Z_SYNC_FLUSH to the zlib library.
+--
+-- Since 0.0.3
+flushDeflate :: Deflate -> (IO (Maybe S.ByteString) -> IO a) -> IO a
+flushDeflate (Deflate (fzstr, fbuff)) f =
+ withForeignPtr fzstr $ \zstr ->
+ f $ drain fbuff zstr c_call_deflate_flush True
4 Codec/Zlib/Lowlevel.hs
View
@@ -16,6 +16,7 @@ module Codec.Zlib.Lowlevel
, c_call_inflate_noflush
, c_call_deflate_noflush
, c_call_deflate_finish
+ , c_call_deflate_flush
, c_call_deflate_set_dictionary
, c_call_inflate_set_dictionary
) where
@@ -81,6 +82,9 @@ foreign import ccall unsafe "call_deflate_noflush"
foreign import ccall unsafe "call_deflate_finish"
c_call_deflate_finish :: ZStream' -> IO CInt
+foreign import ccall unsafe "call_deflate_flush"
+ c_call_deflate_flush :: ZStream' -> IO CInt
+
foreign import ccall unsafe "deflate_set_dictionary"
c_call_deflate_set_dictionary :: ZStream' -> Ptr CChar -> CUInt -> IO ()
5 c/helper.c
View
@@ -81,6 +81,11 @@ int call_deflate_noflush (z_stream *stream)
return deflate(stream, Z_NO_FLUSH);
}
+int call_deflate_flush (z_stream *stream)
+{
+ return deflate(stream, Z_SYNC_FLUSH);
+}
+
int call_deflate_finish (z_stream *stream)
{
return deflate(stream, Z_FINISH);
33 test/main.hs
View
@@ -13,7 +13,7 @@ import qualified Codec.Compression.GZip as Gzip
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
-import Control.Monad (foldM)
+import Control.Monad (foldM, forM_, forM)
import System.IO.Unsafe (unsafePerformIO)
decompress' :: L.ByteString -> L.ByteString
@@ -174,3 +174,34 @@ main = hspecX $ do
deflated <- foldM (go' def) id $ L.toChunks lbs
deflated' <- finishDeflate def $ go deflated
return $ lbs == decompress (L.fromChunks (deflated' []))
+
+ describe "flushing" $ do
+ let helper wb = do
+ let bss0 = replicate 5000 "abc"
+ def <- initDeflate 9 wb
+ inf <- initInflate wb
+
+ let popList pop = do
+ mx <- pop
+ case mx of
+ Nothing -> return []
+ Just x -> do
+ xs <- popList pop
+ return $ x : xs
+
+ let callback name expected pop = do
+ bssDeflated <- popList pop
+ bsInflated <- fmap (S.concat . concat) $ forM bssDeflated $ \bs -> do
+ x <- withInflateInput inf bs popList
+ y <- flushInflate inf
+ return $ x ++ [y]
+ if bsInflated == expected
+ then return ()
+ else error $ "callback " ++ name ++ ", got: " ++ show bsInflated ++ ", expected: " ++ show expected
+
+ forM_ (zip [1..] bss0) $ \(i, bs) -> do
+ withDeflateInput def bs $ callback ("loop" ++ show (i :: Int)) ""
+ flushDeflate def $ callback ("loop" ++ show (i :: Int)) bs
+ finishDeflate def $ callback "finish" ""
+ it "zlib" $ helper defaultWindowBits
+ it "gzip" $ helper $ WindowBits 31
2  zlib-bindings.cabal
View
@@ -1,5 +1,5 @@
name: zlib-bindings
-version: 0.0.2
+version: 0.0.3
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
Please sign in to comment.
Something went wrong with that request. Please try again.