packages feed

zlib-bindings 0.0.1 → 0.0.2

raw patch · 7 files changed

+271/−229 lines, 7 filesdep +HUnitdep +hspecdep +zlib-bindingsdep −HTFdep ~QuickCheckdep ~bytestringdep ~zlib

Dependencies added: HUnit, hspec, zlib-bindings

Dependencies removed: HTF

Dependency ranges changed: QuickCheck, bytestring, zlib

Files

Codec/Zlib.hs view
@@ -22,11 +22,13 @@     ( -- * Inflate       Inflate     , initInflate+    , initInflateWithDictionary     , withInflateInput     , finishInflate       -- * Deflate     , Deflate     , initDeflate+    , initDeflateWithDictionary     , withDeflateInput     , finishDeflate       -- * Data types@@ -39,7 +41,7 @@ import Foreign.ForeignPtr import Foreign.C.Types import Data.ByteString.Unsafe-import Codec.Compression.Zlib (WindowBits (WindowBits), defaultWindowBits)+import Codec.Compression.Zlib (WindowBits(WindowBits), defaultWindowBits) import qualified Data.ByteString as S import Data.ByteString.Lazy.Internal (defaultChunkSize) import Control.Monad (when)@@ -50,7 +52,8 @@  -- | The state of an inflation (eg, decompression) process. All allocated -- memory is automatically reclaimed by the garbage collector.-newtype Inflate = Inflate ZStreamPair+-- Also can contain the inflation dictionary that is used for decompression.+newtype Inflate = Inflate (ZStreamPair, Maybe S.ByteString)  -- | The state of a deflation (eg, compression) process. All allocated memory -- is automatically reclaimed by the garbage collector.@@ -77,10 +80,18 @@ -- * #define Z_BUF_ERROR    (-5) -- -- * #define Z_VERSION_ERROR (-6)+ data ZlibException = ZlibException Int     deriving (Show, Typeable) instance Exception ZlibException +-- | Some constants for the error codes, used internally+zNeedDict :: CInt+zNeedDict = 2++zBufError :: CInt+zBufError = -5+ -- | 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.@@ -92,8 +103,22 @@     fbuff <- mallocForeignPtrBytes defaultChunkSize     withForeignPtr fbuff $ \buff ->         c_set_avail_out zstr buff $ fromIntegral defaultChunkSize-    return $ Inflate (fzstr, fbuff)+    return $ Inflate ((fzstr, fbuff), Nothing) +-- | Initialize an inflation process with the given 'WindowBits'. +-- Unlike initInflate a dictionary for inflation is set which must+-- match the one set during compression.+initInflateWithDictionary :: WindowBits -> S.ByteString -> IO Inflate+initInflateWithDictionary w bs = do+    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), Just bs)+ -- | 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,6 +134,25 @@         c_set_avail_out zstr buff $ fromIntegral defaultChunkSize     return $ Deflate (fzstr, fbuff) +-- | Initialize an deflation process with the given compression level and+-- 'WindowBits'.+-- Unlike initDeflate a dictionary for deflation is set.+initDeflateWithDictionary :: Int -- ^ Compression level+			  -> S.ByteString -- ^ Deflate dictionary+			  -> WindowBits -> IO Deflate+initDeflateWithDictionary level bs w = do+    zstr <- zstreamNew+    deflateInit2 zstr level w 8 StrategyDefault+    fzstr <- newForeignPtr c_free_z_stream_deflate zstr+    fbuff <- mallocForeignPtrBytes defaultChunkSize++    unsafeUseAsCStringLen bs $ \(cstr, len) -> do+        c_call_deflate_set_dictionary zstr cstr $ fromIntegral len++    withForeignPtr fbuff $ \buff ->+        c_set_avail_out zstr buff $ fromIntegral defaultChunkSize+    return $ Deflate (fzstr, fbuff)+ -- | 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@@ -122,11 +166,21 @@ withInflateInput     :: Inflate -> S.ByteString -> (IO (Maybe S.ByteString) -> IO a)     -> IO a-withInflateInput (Inflate (fzstr, fbuff)) bs f =+withInflateInput (Inflate ((fzstr, fbuff), inflateDictionary)) bs f =     withForeignPtr fzstr $ \zstr ->         unsafeUseAsCStringLen bs $ \(cstr, len) -> do             c_set_avail_in zstr cstr $ fromIntegral len-            f $ drain fbuff zstr c_call_inflate_noflush False+            f $ drain fbuff zstr 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  drain :: ForeignPtr CChar -> ZStream' -> (ZStream' -> IO CInt) -> Bool       -> IO (Maybe S.ByteString)@@ -136,7 +190,7 @@         then return Nothing         else withForeignPtr fbuff $ \buff -> do             res <- func zstr-            when (res < 0 && res /= (-5))+            when (res < 0 && res /= zBufError)                 $ throwIO $ ZlibException $ fromIntegral res             avail <- c_get_avail_out zstr             let size = defaultChunkSize - fromIntegral avail@@ -149,12 +203,13 @@                     return $ Just bs                 else return Nothing + -- | As explained in 'withInflateInput', inflation buffers your decompressed -- data. After you call 'withInflateInput' with your last chunk of compressed -- data, you will likely have some data still sitting in the buffer. This -- function will return it to you. finishInflate :: Inflate -> IO S.ByteString-finishInflate (Inflate (fzstr, fbuff)) =+finishInflate (Inflate ((fzstr, fbuff), _)) =     withForeignPtr fzstr $ \zstr ->         withForeignPtr fbuff $ \buff -> do             avail <- c_get_avail_out zstr@@ -188,3 +243,4 @@ finishDeflate (Deflate (fzstr, fbuff)) f =     withForeignPtr fzstr $ \zstr ->         f $ drain fbuff zstr c_call_deflate_finish True+
Codec/Zlib/Lowlevel.hs view
@@ -16,6 +16,8 @@     , c_call_inflate_noflush     , c_call_deflate_noflush     , c_call_deflate_finish+    , c_call_deflate_set_dictionary+    , c_call_inflate_set_dictionary     ) where  import Foreign.C@@ -78,6 +80,12 @@  foreign import ccall unsafe "call_deflate_finish"     c_call_deflate_finish :: ZStream' -> IO CInt++foreign import ccall unsafe "deflate_set_dictionary"+    c_call_deflate_set_dictionary :: ZStream' -> Ptr CChar -> CUInt -> IO ()++foreign import ccall unsafe "inflate_set_dictionary"+    c_call_inflate_set_dictionary :: ZStream' -> Ptr CChar -> CUInt -> IO ()  wbToInt :: WindowBits -> CInt wbToInt (WindowBits i) = fromIntegral i
c/helper.c view
@@ -27,6 +27,16 @@ 	return deflateInit2(stream, level, Z_DEFLATED, methodBits, memlevel, strategy); } +int inflate_set_dictionary(z_stream *stream, const char* dictionary, +                            unsigned int dictLength) {+        return inflateSetDictionary(stream, dictionary, dictLength);+}++int deflate_set_dictionary(z_stream *stream, const char* dictionary, +                            unsigned int dictLength) {+        return deflateSetDictionary(stream, dictionary, dictLength);+}+ void free_z_stream_inflate (z_stream *stream) { 	inflateEnd(stream);
− file-test.hs 
@@ -1,44 +0,0 @@-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
− test.hs 
@@ -1,148 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--import System.Environment ( getArgs )-import Test.Framework--import Codec.Zlib-import Codec.Compression.Zlib-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 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 8 $ WindowBits 31-    gziped <- withDeflateInput def license $ go id-    gziped' <- finishDeflate def $ go gziped-    let raw' = L.fromChunks [license]-    assertEqual raw' $ Gzip.decompress $ L.fromChunks $ gziped' []-  where-    go front x = do-        y <- x-        case y of-            Nothing -> return front-            Just z -> go (front . (:) z) x--test_license_single_inflate :: Assertion-test_license_single_inflate = do-    gziped <- S.readFile "LICENSE.gz"-    inf <- initInflate $ WindowBits 31-    ungziped <- withInflateInput inf gziped $ go id-    final <- finishInflate inf-    assertEqual license $ S.concat $ ungziped [final]-  where-    go front x = do-        y <- x-        case y of-            Nothing -> return front-            Just z -> go (front . (:) z) x--test_license_multi_deflate :: Assertion-test_license_multi_deflate = do-    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]-    assertEqual raw' $ Gzip.decompress $ L.fromChunks $ gziped' []-  where-    go' inf front bs = withDeflateInput inf bs $ go front-    go front x = do-        y <- x-        case y of-            Nothing -> return front-            Just z -> go (front . (:) z) x--test_license_multi_inflate :: Assertion-test_license_multi_inflate = do-    gziped <- S.readFile "LICENSE.gz"-    let gziped' = map S.singleton $ S.unpack gziped-    inf <- initInflate $ WindowBits 31-    ungziped' <- foldM (go' inf) id gziped'-    final <- finishInflate inf-    assertEqual license $ S.concat $ 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--instance Arbitrary L.ByteString where-    arbitrary = L.fromChunks `fmap` arbitrary-instance Arbitrary S.ByteString where-    arbitrary = S.pack `fmap` arbitrary--prop_lbs_zlib_inflate :: L.ByteString -> Bool-prop_lbs_zlib_inflate lbs = unsafePerformIO $ do-    let glbs = compress lbs-    inf <- initInflate defaultWindowBits-    inflated <- foldM (go' inf) id $ L.toChunks glbs-    final <- finishInflate inf-    return $ lbs == L.fromChunks (inflated [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_lbs_zlib_deflate :: L.ByteString -> Bool-prop_lbs_zlib_deflate lbs = unsafePerformIO $ do-    def <- initDeflate 7 defaultWindowBits-    deflated <- foldM (go' def) id $ L.toChunks lbs-    deflated' <- finishDeflate def $ go deflated-    return $ lbs == decompress (L.fromChunks (deflated' []))-  where-    go' inf front bs = withDeflateInput inf bs $ go front-    go front x = do-        y <- x-        case y of-            Nothing -> return front-            Just z -> go (front . (:) z) x--main = do-    args <- getArgs-    runTestWithArgs args allHTFTests
+ test/main.hs view
@@ -0,0 +1,176 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec.Monadic+import Test.Hspec.HUnit ()+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary (..))+import Test.HUnit++import Codec.Zlib+import Codec.Compression.Zlib+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 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++instance Arbitrary L.ByteString where+    arbitrary = L.fromChunks `fmap` arbitrary+instance Arbitrary S.ByteString where+    arbitrary = S.pack `fmap` arbitrary++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++license :: S.ByteString+license = S8.filter (/= '\r') $ unsafePerformIO $ S.readFile "LICENSE"++exampleDict :: S.ByteString+exampleDict = "INITIALDICTIONARY"++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+    return $ L.fromChunks $ compressed' []+  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++inflateWithDict :: S.ByteString -> L.ByteString -> L.ByteString+inflateWithDict dict compressed = unsafePerformIO $ do+    inf <- initInflateWithDictionary (WindowBits 15) dict+    decompressed <- foldM (go' inf) id $ L.toChunks compressed+    final <- finishInflate inf+    return $ L.fromChunks $ decompressed [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++main :: IO ()+main = hspecX $ do+    describe "inflate/deflate" $ do+        prop "decompress'" $ \lbs -> lbs == decompress' (compress lbs)+        prop "compress'" $ \lbs -> lbs == decompress (compress' lbs)++        prop "with dictionary" $ \bs ->+            bs ==+            (inflateWithDict exampleDict . deflateWithDict exampleDict) bs+        it "different dict" $ do+            raw <- L.readFile "LICENSE"+            deflated <- return $ deflateWithDict exampleDict raw+            inflated <- return $ inflateWithDict (S.drop 1 exampleDict) deflated+            assertBool "is null" $ L.null inflated++    describe "license" $ do+        it "single deflate" $ do+            let go front x = do+                    y <- x+                    case y of+                        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+            let raw' = L.fromChunks [license]+            raw' @?= Gzip.decompress (L.fromChunks $ gziped' [])++        it "single inflate" $ do+            let go front x = do+                    y <- x+                    case y of+                        Nothing -> return front+                        Just z -> go (front . (:) z) x+            gziped <- S.readFile "LICENSE.gz"+            inf <- initInflate $ WindowBits 31+            ungziped <- withInflateInput inf gziped $ go id+            final <- finishInflate inf+            license @?= (S.concat $ ungziped [final])++        it "multi deflate" $ do+            let go' inf front bs = withDeflateInput 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+            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+                go front x = do+                    y <- x+                    case y of+                        Nothing -> return front+                        Just z -> go (front . (:) z) x+            gziped <- S.readFile "LICENSE.gz"+            let gziped' = map S.singleton $ S.unpack gziped+            inf <- initInflate $ WindowBits 31+            ungziped' <- foldM (go' inf) id gziped'+            final <- finishInflate inf+            license @?= (S.concat $ ungziped' [final])++    describe "lbs zlib" $ do+        prop "inflate" $ \lbs -> unsafePerformIO $ do+            let glbs = compress lbs+                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+            inf <- initInflate defaultWindowBits+            inflated <- foldM (go' inf) id $ L.toChunks glbs+            final <- finishInflate inf+            return $ lbs == L.fromChunks (inflated [final])+        prop "deflate" $ \lbs -> unsafePerformIO $ do+            let go' inf front bs = withDeflateInput 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+            return $ lbs == decompress (L.fromChunks (deflated' []))
zlib-bindings.cabal view
@@ -1,5 +1,5 @@ name:            zlib-bindings-version:         0.0.1+version:         0.0.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -7,12 +7,12 @@ synopsis:        Low-level bindings to the zlib package. category:        Codec stability:       Experimental-cabal-version:   >= 1.6+cabal-version:   >= 1.8 build-type:      Simple homepage:        http://github.com/snoyberg/zlib-bindings extra-source-files: cbits/crc32.h cbits/inffast.h cbits/inflate.h                     cbits/trees.h cbits/deflate.h cbits/inffixed.h-                    cbits/inftrees.h cbits/zutil.h+                    cbits/inftrees.h cbits/zutil.h, test/main.hs flag test   description: Build the test executable.   default: False@@ -31,34 +31,18 @@         include-dirs:  cbits         install-includes: zlib.h zconf.h -executable zlib-bindings-test -    main-is: test.hs-    if flag(test)-        Buildable: True-        build-depends: base                  >= 4       && < 5-                     , bytestring            >= 0.9.1.4 && < 0.10-                     , zlib                  >= 0.5.2.0 && < 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+test-suite test +    main-is: main.hs+    hs-source-dirs: test+    type: exitcode-stdio-1.0+    build-depends: base                  >= 4       && < 5+                 , bytestring+                 , zlib+                 , zlib-bindings+                 , hspec+                 , QuickCheck            >= 2.3+                 , HUnit     ghc-options:     -Wall-    c-sources:       c/helper.c-    if os(windows)-        include-dirs:  cbits-        install-includes: zlib.h zconf.h  source-repository head   type:     git