Browse files

Get rid of callback interface

  • Loading branch information...
1 parent f73eea3 commit e084a1b93df45e2f1784381e76103dd01a4e6ef5 @snoyberg committed Mar 1, 2012
Showing with 65 additions and 55 deletions.
  1. +44 −35 Codec/Zlib.hs
  2. +20 −19 test/main.hs
  3. +1 −1 zlib-bindings.cabal
View
79 Codec/Zlib.hs
@@ -23,20 +23,21 @@ module Codec.Zlib
Inflate
, initInflate
, initInflateWithDictionary
- , withInflateInput
+ , feedInflate
, finishInflate
, flushInflate
-- * Deflate
, Deflate
, initDeflate
, initDeflateWithDictionary
- , withDeflateInput
+ , feedDeflate
, finishDeflate
, flushDeflate
-- * Data types
, WindowBits (..)
, defaultWindowBits
, ZlibException (..)
+ , Popper
) where
import Codec.Zlib.Lowlevel
@@ -140,8 +141,8 @@ initDeflate level w = do
-- 'WindowBits'.
-- Unlike initDeflate a dictionary for deflation is set.
initDeflateWithDictionary :: Int -- ^ Compression level
- -> S.ByteString -- ^ Deflate dictionary
- -> WindowBits -> IO Deflate
+ -> S.ByteString -- ^ Deflate dictionary
+ -> WindowBits -> IO Deflate
initDeflateWithDictionary level bs w = do
zstr <- zstreamNew
deflateInit2 zstr level w 8 StrategyDefault
@@ -165,28 +166,40 @@ initDeflateWithDictionary level bs w = do
-- until that much decompressed data is available. After you have fed all of
-- the compressed data to this function, you can extract your final chunk of
-- decompressed data using 'finishInflate'.
-withInflateInput
- :: Inflate -> S.ByteString -> (IO (Maybe S.ByteString) -> IO a)
- -> IO a
-withInflateInput (Inflate ((fzstr, fbuff), inflateDictionary)) bs f =
+feedInflate
+ :: Inflate
+ -> S.ByteString
+ -> IO Popper
+feedInflate (Inflate ((fzstr, fbuff), inflateDictionary)) bs = do
withForeignPtr fzstr $ \zstr ->
- unsafeUseAsCStringLen bs $ \(cstr, len) -> do
+ unsafeUseAsCStringLen bs $ \(cstr, len) ->
c_set_avail_in zstr cstr $ fromIntegral len
- f $ drain fbuff zstr inflate False
+ return $ drain fbuff fzstr (Just bs) inflate False
where
inflate zstr = do
- res <- c_call_inflate_noflush zstr
- if (res == zNeedDict)
- then maybe (throwIO $ ZlibException $ fromIntegral zNeedDict) -- no dictionary supplied so throw error
- (\dict -> (unsafeUseAsCStringLen dict $ \(cstr, len) -> do
- c_call_inflate_set_dictionary zstr cstr $ fromIntegral len
- c_call_inflate_noflush zstr))
- inflateDictionary
- else return res
+ res <- c_call_inflate_noflush zstr
+ if (res == zNeedDict)
+ then maybe (throwIO $ ZlibException $ fromIntegral zNeedDict) -- no dictionary supplied so throw error
+ (\dict -> (unsafeUseAsCStringLen dict $ \(cstr, len) -> do
+ c_call_inflate_set_dictionary zstr cstr $ fromIntegral len
+ c_call_inflate_noflush zstr))
+ inflateDictionary
+ else return res
+
+type Popper = IO (Maybe S.ByteString)
+
+-- | Ensure that the given @ByteString@ is not deallocated.
+keepAlive :: Maybe S.ByteString -> IO a -> IO a
+keepAlive Nothing = id
+keepAlive (Just bs) = unsafeUseAsCStringLen bs . const
-drain :: ForeignPtr CChar -> ZStream' -> (ZStream' -> IO CInt) -> Bool
- -> IO (Maybe S.ByteString)
-drain fbuff zstr func isFinish = do
+drain :: ForeignPtr CChar
+ -> ForeignPtr ZStreamStruct
+ -> Maybe S.ByteString
+ -> (ZStream' -> IO CInt)
+ -> Bool
+ -> Popper
+drain fbuff fzstr mbs func isFinish = withForeignPtr fzstr $ \zstr -> keepAlive mbs $ do
a <- c_get_avail_in zstr
if a == 0 && not isFinish
then return Nothing
@@ -217,8 +230,7 @@ finishInflate (Inflate ((fzstr, fbuff), _)) =
avail <- c_get_avail_out zstr
let size = defaultChunkSize - fromIntegral avail
bs <- S.packCStringLen (buff, size)
- c_set_avail_out zstr buff
- $ fromIntegral defaultChunkSize
+ c_set_avail_out zstr buff $ fromIntegral defaultChunkSize
return bs
-- | Flush the inflation buffer. Useful for interactive application.
@@ -240,30 +252,27 @@ flushInflate = finishInflate
-- until that much compressed data is available. After you have fed all of the
-- decompressed data to this function, you can extract your final chunks of
-- compressed data using 'finishDeflate'.
-withDeflateInput
- :: Deflate -> S.ByteString -> (IO (Maybe S.ByteString) -> IO a) -> IO a
-withDeflateInput (Deflate (fzstr, fbuff)) bs f =
+feedDeflate :: Deflate -> S.ByteString -> IO Popper
+feedDeflate (Deflate (fzstr, fbuff)) bs = do
withForeignPtr fzstr $ \zstr ->
unsafeUseAsCStringLen bs $ \(cstr, len) -> do
c_set_avail_in zstr cstr $ fromIntegral len
- f $ drain fbuff zstr c_call_deflate_noflush False
+ return $ drain fbuff fzstr (Just bs) c_call_deflate_noflush False
-- | As explained in 'withDeflateInput', deflation buffers your compressed
-- data. After you call 'withDeflateInput' with your last chunk of decompressed
-- data, we need to flush the rest of the data waiting to be deflated. This
-- function takes a function parameter which accepts a \"popper\", just like
-- 'withDeflateInput'.
-finishDeflate :: Deflate -> (IO (Maybe S.ByteString) -> IO a) -> IO a
-finishDeflate (Deflate (fzstr, fbuff)) f =
- withForeignPtr fzstr $ \zstr ->
- f $ drain fbuff zstr c_call_deflate_finish True
+finishDeflate :: Deflate -> Popper
+finishDeflate (Deflate (fzstr, fbuff)) =
+ drain fbuff fzstr Nothing 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
+flushDeflate :: Deflate -> Popper
+flushDeflate (Deflate (fzstr, fbuff)) =
+ drain fbuff fzstr Nothing c_call_deflate_flush True
View
39 test/main.hs
@@ -23,7 +23,7 @@ decompress' gziped = unsafePerformIO $ do
final <- finishInflate inf
return $ L.fromChunks $ ungziped [final]
where
- go' inf front bs = withInflateInput inf bs $ go front
+ go' inf front bs = feedInflate inf bs >>= go front
go front x = do
y <- x
case y of
@@ -39,10 +39,10 @@ compress' :: L.ByteString -> L.ByteString
compress' raw = unsafePerformIO $ do
def <- initDeflate 7 defaultWindowBits
gziped <- foldM (go' def) id $ L.toChunks raw
- gziped' <- finishDeflate def $ go gziped
+ gziped' <- go gziped $ finishDeflate def
return $ L.fromChunks $ gziped' []
where
- go' def front bs = withDeflateInput def bs $ go front
+ go' def front bs = feedDeflate def bs >>= go front
go front x = do
y <- x
case y of
@@ -59,10 +59,10 @@ deflateWithDict :: S.ByteString -> L.ByteString -> L.ByteString
deflateWithDict dict raw = unsafePerformIO $ do
def <- initDeflateWithDictionary 7 dict $ WindowBits 15
compressed <- foldM (go' def) id $ L.toChunks raw
- compressed' <- finishDeflate def $ go compressed
+ compressed' <- go compressed $ finishDeflate def
return $ L.fromChunks $ compressed' []
where
- go' def front bs = withDeflateInput def bs $ go front
+ go' def front bs = feedDeflate def bs >>= go front
go front x = do
y <- x
case y of
@@ -76,7 +76,7 @@ inflateWithDict dict compressed = unsafePerformIO $ do
final <- finishInflate inf
return $ L.fromChunks $ decompressed [final]
where
- go' inf front bs = withInflateInput inf bs $ go front
+ go' inf front bs = feedInflate inf bs >>= go front
go front x = do
y <- x
case y of
@@ -106,8 +106,8 @@ main = hspecX $ do
Nothing -> return front
Just z -> go (front . (:) z) x
def <- initDeflate 8 $ WindowBits 31
- gziped <- withDeflateInput def license $ go id
- gziped' <- finishDeflate def $ go gziped
+ gziped <- feedDeflate def license >>= go id
+ gziped' <- go gziped $ finishDeflate def
let raw' = L.fromChunks [license]
raw' @?= Gzip.decompress (L.fromChunks $ gziped' [])
@@ -119,25 +119,26 @@ main = hspecX $ do
Just z -> go (front . (:) z) x
gziped <- S.readFile "LICENSE.gz"
inf <- initInflate $ WindowBits 31
- ungziped <- withInflateInput inf gziped $ go id
+ popper <- feedInflate inf gziped
+ ungziped <- go id popper
final <- finishInflate inf
license @?= (S.concat $ ungziped [final])
it "multi deflate" $ do
- let go' inf front bs = withDeflateInput inf bs $ go front
+ let go' inf front bs = feedDeflate inf bs >>= go front
go front x = do
y <- x
case y of
Nothing -> return front
Just z -> go (front . (:) z) x
def <- initDeflate 5 $ WindowBits 31
gziped <- foldM (go' def) id $ map S.singleton $ S.unpack license
- gziped' <- finishDeflate def $ go gziped
+ gziped' <- go gziped $ finishDeflate def
let raw' = L.fromChunks [license]
raw' @?= (Gzip.decompress $ L.fromChunks $ gziped' [])
it "multi inflate" $ do
- let go' inf front bs = withInflateInput inf bs $ go front
+ let go' inf front bs = feedInflate inf bs >>= go front
go front x = do
y <- x
case y of
@@ -153,7 +154,7 @@ main = hspecX $ do
describe "lbs zlib" $ do
prop "inflate" $ \lbs -> unsafePerformIO $ do
let glbs = compress lbs
- go' inf front bs = withInflateInput inf bs $ go front
+ go' inf front bs = feedInflate inf bs >>= go front
go front x = do
y <- x
case y of
@@ -164,15 +165,15 @@ main = hspecX $ do
final <- finishInflate inf
return $ lbs == L.fromChunks (inflated [final])
prop "deflate" $ \lbs -> unsafePerformIO $ do
- let go' inf front bs = withDeflateInput inf bs $ go front
+ let go' inf front bs = feedDeflate inf bs >>= go front
go front x = do
y <- x
case y of
Nothing -> return front
Just z -> go (front . (:) z) x
def <- initDeflate 7 defaultWindowBits
deflated <- foldM (go' def) id $ L.toChunks lbs
- deflated' <- finishDeflate def $ go deflated
+ deflated' <- go deflated $ finishDeflate def
return $ lbs == decompress (L.fromChunks (deflated' []))
describe "flushing" $ do
@@ -192,16 +193,16 @@ main = hspecX $ do
let callback name expected pop = do
bssDeflated <- popList pop
bsInflated <- fmap (S.concat . concat) $ forM bssDeflated $ \bs -> do
- x <- withInflateInput inf bs popList
+ x <- feedInflate 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" ""
+ feedDeflate def bs >>= callback ("loop" ++ show (i :: Int)) ""
+ callback ("loop" ++ show (i :: Int)) bs $ flushDeflate def
+ callback "finish" "" $ finishDeflate def
it "zlib" $ helper defaultWindowBits
it "gzip" $ helper $ WindowBits 31
View
2 zlib-bindings.cabal
@@ -1,5 +1,5 @@
name: zlib-bindings
-version: 0.0.3.2
+version: 0.1.0
license: BSD3
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

0 comments on commit e084a1b

Please sign in to comment.