zlib-bindings 0.0.0 → 0.0.1

raw patch · 6 files changed

+219/−81 lines, 6 filesdep ~HTFnew-component:exe:zlib-bindings-file-testPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: HTF

API changes (from Hackage documentation)

Files

• Codec/Zlib.hs +17/−45
• Codec/Zlib/Lowlevel.hs +85/−0
• c/helper.c +21/−30
• file-test.hs +44/−0
• test.hs +37/−4
• zlib-bindings.cabal +15/−2

@@ -1,5 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE DeriveDataTypeable #-} -- | This is a middle-level wrapper around the zlib C API. It allows you to -- work fully with bytestrings and not touch the FFI at all, but is still@@ -9,6 +7,17 @@ -- You'll probably need to reference the docs a bit to understand the -- WindowBits parameters below, but a basic rule of thumb is 15 is for zlib -- compression, and 31 for gzip compression.+--+-- A simple streaming compressor in pseudo-code would look like:+--+-- > def <- initDeflate ...+-- > withDeflateInput def rawContent1 sendCompressedData+-- > withDeflateInput def rawContent2 sendCompressedData+-- > ...+-- > finishDeflate def sendCompressedData+--+-- You can see a more complete example is available in the included+-- file-test.hs. module Codec.Zlib     ( -- * Inflate       Inflate@@ -26,9 +35,9 @@     , ZlibException (..)     ) where -import Foreign.C-import Foreign.Ptr+import Codec.Zlib.Lowlevel import Foreign.ForeignPtr+import Foreign.C.Types import Data.ByteString.Unsafe import Codec.Compression.Zlib (WindowBits (WindowBits), defaultWindowBits) import qualified Data.ByteString as S@@ -37,8 +46,6 @@ import Data.Typeable (Typeable) import Control.Exception (Exception, throwIO) -data ZStreamStruct-type ZStream' = Ptr ZStreamStruct type ZStreamPair = (ForeignPtr ZStreamStruct, ForeignPtr CChar)  -- | The state of an inflation (eg, decompression) process. All allocated@@ -74,34 +81,19 @@     deriving (Show, Typeable) instance Exception ZlibException -foreign import ccall unsafe "create_z_stream_inflate"-    c_create_z_stream_inflate :: CInt -> IO ZStream'--foreign import ccall unsafe "&free_z_stream_inflate"-    c_free_z_stream_inflate :: FunPtr (ZStream' -> IO ())--wbToInt :: WindowBits -> CInt-wbToInt (WindowBits i) = fromIntegral i-wbToInt _ = 15- -- | Initialize an inflation process with the given 'WindowBits'. You will need -- to call 'withInflateInput' to feed compressed data to this and -- 'finishInflate' to extract the final chunk of decompressed data. initInflate :: WindowBits -> IO Inflate initInflate w = do-    zstr <- c_create_z_stream_inflate $ wbToInt w+    zstr <- zstreamNew+    inflateInit2 zstr w     fzstr <- newForeignPtr c_free_z_stream_inflate zstr     fbuff <- mallocForeignPtrBytes defaultChunkSize     withForeignPtr fbuff $ \buff ->         c_set_avail_out zstr buff $ fromIntegral defaultChunkSize     return $ Inflate (fzstr, fbuff) -foreign import ccall unsafe "create_z_stream_deflate"-    c_create_z_stream_deflate :: CInt -> CInt -> IO ZStream'--foreign import ccall unsafe "&free_z_stream_deflate"-    c_free_z_stream_deflate :: FunPtr (ZStream' -> IO ())- -- | Initialize a deflation process with the given compression level and -- 'WindowBits'. You will need to call 'withDeflateInput' to feed uncompressed -- data to this and 'finishDeflate' to extract the final chunks of compressed@@ -109,28 +101,14 @@ initDeflate :: Int -- ^ Compression level             -> WindowBits -> IO Deflate initDeflate level w = do-    zstr <- c_create_z_stream_deflate (fromIntegral level) $ wbToInt w+    zstr <- zstreamNew+    deflateInit2 zstr level w 8 StrategyDefault     fzstr <- newForeignPtr c_free_z_stream_deflate zstr     fbuff <- mallocForeignPtrBytes defaultChunkSize     withForeignPtr fbuff $ \buff ->         c_set_avail_out zstr buff $ fromIntegral defaultChunkSize     return $ Deflate (fzstr, fbuff) -foreign import ccall unsafe "set_avail_in"-    c_set_avail_in :: ZStream' -> Ptr CChar -> CUInt -> IO ()--foreign import ccall unsafe "set_avail_out"-    c_set_avail_out :: ZStream' -> Ptr CChar -> CUInt -> IO ()--foreign import ccall unsafe "get_avail_out"-    c_get_avail_out :: ZStream' -> IO CUInt--foreign import ccall unsafe "get_avail_in"-    c_get_avail_in :: ZStream' -> IO CUInt--foreign import ccall unsafe "call_inflate_noflush"-    c_call_inflate_noflush :: ZStream' -> IO CInt- -- | Feed the given 'S.ByteString' to the inflater. This function takes a -- function argument which takes a \"popper\". A popper is an IO action that -- will return the next bit of inflated data, returning 'Nothing' when there is@@ -183,9 +161,6 @@             let size = defaultChunkSize - fromIntegral avail             S.packCStringLen (buff, size) -foreign import ccall unsafe "call_deflate_noflush"-    c_call_deflate_noflush :: ZStream' -> IO CInt- -- | 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 -- will return the next bit of deflated data, returning 'Nothing' when there is@@ -203,9 +178,6 @@         unsafeUseAsCStringLen bs $ \(cstr, len) -> do             c_set_avail_in zstr cstr $ fromIntegral len             f $ drain fbuff zstr c_call_deflate_noflush False--foreign import ccall unsafe "call_deflate_finish"-    c_call_deflate_finish :: ZStream' -> IO CInt  -- | As explained in 'withDeflateInput', deflation buffers your compressed -- data. After you call 'withDeflateInput' with your last chunk of decompressed

@@ -0,0 +1,85 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+module Codec.Zlib.Lowlevel+    ( ZStreamStruct+    , ZStream'+    , zstreamNew+    , Strategy(..)+    , deflateInit2+    , inflateInit2+    , c_free_z_stream_inflate+    , c_free_z_stream_deflate+    , c_set_avail_in+    , c_set_avail_out+    , c_get_avail_out+    , c_get_avail_in+    , c_call_inflate_noflush+    , c_call_deflate_noflush+    , c_call_deflate_finish+    ) where++import Foreign.C+import Foreign.Ptr+import Codec.Compression.Zlib (WindowBits (WindowBits))++data ZStreamStruct+type ZStream' = Ptr ZStreamStruct++data Strategy =+      StrategyDefault+    | StrategyFiltered+    | StrategyHuffman+    | StrategyRLE+    | StrategyFixed+    deriving (Show,Eq,Ord,Enum)++foreign import ccall unsafe "create_z_stream"+    zstreamNew :: IO ZStream'++foreign import ccall unsafe "deflate_init2"+    c_deflateInit2 :: ZStream' -> CInt -> CInt -> CInt -> CInt+                   -> IO ()++deflateInit2 :: ZStream' -> Int -> WindowBits -> Int -> Strategy -> IO ()+deflateInit2 zstream level windowBits memlevel strategy =+    c_deflateInit2 zstream (fromIntegral level) (wbToInt windowBits)+                   (fromIntegral memlevel)+                   (fromIntegral $ fromEnum strategy)++foreign import ccall unsafe "inflate_init2"+    c_inflateInit2 :: ZStream' -> CInt -> IO ()++inflateInit2 :: ZStream' -> WindowBits -> IO ()+inflateInit2 zstream wb = c_inflateInit2 zstream (wbToInt wb)++foreign import ccall unsafe "&free_z_stream_inflate"+    c_free_z_stream_inflate :: FunPtr (ZStream' -> IO ())++foreign import ccall unsafe "&free_z_stream_deflate"+    c_free_z_stream_deflate :: FunPtr (ZStream' -> IO ())++foreign import ccall unsafe "set_avail_in"+    c_set_avail_in :: ZStream' -> Ptr CChar -> CUInt -> IO ()++foreign import ccall unsafe "set_avail_out"+    c_set_avail_out :: ZStream' -> Ptr CChar -> CUInt -> IO ()++foreign import ccall unsafe "get_avail_out"+    c_get_avail_out :: ZStream' -> IO CUInt++foreign import ccall unsafe "get_avail_in"+    c_get_avail_in :: ZStream' -> IO CUInt++foreign import ccall unsafe "call_inflate_noflush"+    c_call_inflate_noflush :: ZStream' -> IO CInt++foreign import ccall unsafe "call_deflate_noflush"+    c_call_deflate_noflush :: ZStream' -> IO CInt++foreign import ccall unsafe "call_deflate_finish"+    c_call_deflate_finish :: ZStream' -> IO CInt++wbToInt :: WindowBits -> CInt+wbToInt (WindowBits i) = fromIntegral i+wbToInt _ = 15+

@@ -1,21 +1,32 @@ #include <zlib.h> #include <stdlib.h> -z_stream * create_z_stream_inflate (int window_bits)+z_stream * create_z_stream(void) { 	z_stream *ret = malloc(sizeof(z_stream));-	ret->zalloc = Z_NULL;-	ret->zfree = Z_NULL;-	ret->opaque = Z_NULL;-	ret->next_in = NULL;-	ret->avail_in = 0;+	if (ret) {+		ret->zalloc = Z_NULL;+		ret->zfree = Z_NULL;+		ret->opaque = Z_NULL;+		ret->next_in = NULL;+		ret->avail_in = 0;+		ret->next_out = NULL;+		ret->avail_out = 0;+	}+	return ret;+} -	if (inflateInit2(ret, window_bits) != Z_OK)-	    return NULL;-	else-	    return ret;+int inflate_init2(z_stream *stream, int window_bits)+{+	return inflateInit2(stream, window_bits); } +int deflate_init2(z_stream *stream, int level, int methodBits,+                  int memlevel, int strategy)+{+	return deflateInit2(stream, level, Z_DEFLATED, methodBits, memlevel, strategy);+}+ void free_z_stream_inflate (z_stream *stream) { 	inflateEnd(stream);@@ -47,26 +58,6 @@ unsigned int get_avail_out (z_stream *stream) { 	return stream->avail_out;-}--z_stream * create_z_stream_deflate (int level, int window_bits)-{-	z_stream *ret = malloc(sizeof(z_stream));-	ret->zalloc = Z_NULL;-	ret->zfree = Z_NULL;-	ret->opaque = Z_NULL;-	ret->next_in = NULL;-	ret->avail_in = 0;--	if (deflateInit2(ret,-			 level,-			 Z_DEFLATED,-			 window_bits,-			 8,-			 Z_DEFAULT_STRATEGY)-		!= Z_OK)                 return NULL;-	else-	    return ret; }  void free_z_stream_deflate (z_stream *stream)

@@ -0,0 +1,44 @@+import Codec.Zlib+import System.Environment (getArgs)+import System.IO+import qualified Data.ByteString as S+import Control.Monad (unless)++main = do+    [action, inFile, outFile] <- getArgs+    withFile inFile ReadMode $ \inH ->+        withFile outFile WriteMode $ \outH ->+            case action of+                "inflate" -> inflate inH outH+                "deflate" -> deflate inH outH++inflate inH outH = do+    inf <- initInflate $ WindowBits 31+    go inf+    bs <- finishInflate inf+    S.hPutStr outH bs+  where+    go inf = do+        bs <- S.hGet inH 1024+        unless (S.null bs) $ do+            withInflateInput inf bs $ writer outH+            go inf++deflate inH outH = do+    def <- initDeflate 7 $ WindowBits 31+    go def+    finishDeflate def $ writer outH+  where+    go def = do+        bs <- S.hGet inH 1024+        unless (S.null bs) $ do+            withDeflateInput def bs $ writer outH+            go def++writer outH pop = do+    mbs <- pop+    case mbs of+        Nothing -> return ()+        Just bs -> do+            S.hPutStr outH bs+            writer outH pop

@@ -13,12 +13,46 @@ import Control.Monad (foldM) import System.IO.Unsafe (unsafePerformIO) +decompress' :: L.ByteString -> L.ByteString+decompress' gziped = unsafePerformIO $ do+    inf <- initInflate defaultWindowBits+    ungziped <- foldM (go' inf) id $ L.toChunks gziped+    final <- finishInflate inf+    return $ L.fromChunks $ 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++prop_decompress' :: L.ByteString -> Bool+prop_decompress' lbs = lbs == decompress' (compress lbs)++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+    return $ L.fromChunks $ 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++prop_compress' :: L.ByteString -> Bool+prop_compress' lbs = lbs == decompress (compress' lbs)+ license :: S.ByteString license = S8.filter (/= '\r') $ unsafePerformIO $ S.readFile "LICENSE"  test_license_single_deflate :: Assertion test_license_single_deflate = do-    def <- initDeflate $ WindowBits 31+    def <- initDeflate 8 $ WindowBits 31     gziped <- withDeflateInput def license $ go id     gziped' <- finishDeflate def $ go gziped     let raw' = L.fromChunks [license]@@ -46,7 +80,7 @@  test_license_multi_deflate :: Assertion test_license_multi_deflate = do-    def <- initDeflate $ WindowBits 31+    def <- initDeflate 5 $ WindowBits 31     gziped <- foldM (go' def) id $ map S.singleton $ S.unpack license     gziped' <- finishDeflate def $ go gziped     let raw' = L.fromChunks [license]@@ -97,7 +131,7 @@  prop_lbs_zlib_deflate :: L.ByteString -> Bool prop_lbs_zlib_deflate lbs = unsafePerformIO $ do-    def <- initDeflate defaultWindowBits+    def <- initDeflate 7 defaultWindowBits     deflated <- foldM (go' def) id $ L.toChunks lbs     deflated' <- finishDeflate def $ go deflated     return $ lbs == decompress (L.fromChunks (deflated' []))@@ -109,7 +143,6 @@             Nothing -> return front             Just z -> go (front . (:) z) x -main :: IO () main = do     args <- getArgs     runTestWithArgs args allHTFTests

@@ -1,5 +1,5 @@ name:            zlib-bindings-version:         0.0.0+version:         0.0.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -24,6 +24,7 @@                  , bytestring            >= 0.9.1.4 && < 0.10                  , zlib                  >= 0.5.2.0 && < 0.6     exposed-modules: Codec.Zlib+                     Codec.Zlib.Lowlevel     ghc-options:     -Wall     c-sources:       c/helper.c     if os(windows)@@ -37,8 +38,20 @@         build-depends: base                  >= 4       && < 5                      , bytestring            >= 0.9.1.4 && < 0.10                      , zlib                  >= 0.5.2.0 && < 0.6-                     , HTF                   >= 0.5     && < 0.6+                     , HTF                   >= 0.5     && < 0.8                      , QuickCheck            >= 2.1.2+    else+        Buildable: False+    ghc-options:     -Wall+    c-sources:       c/helper.c+    if os(windows)+        include-dirs:  cbits+        install-includes: zlib.h zconf.h++executable zlib-bindings-file-test+    main-is: file-test.hs+    if flag(test)+        Buildable: True     else         Buildable: False     ghc-options:     -Wall