packages feed

snappy 0.1.0.0 → 0.2.0.0

raw patch · 10 files changed

+443/−43 lines, 10 files

Files

Codec/Compression/Snappy.hs view
@@ -8,9 +8,12 @@ -- Stability:   experimental -- Portability: portable ----- This library provides fast, pure Haskell bindings to Google's+-- This module provides fast, pure Haskell bindings to Google's -- Snappy compression and decompression library: -- <http://code.google.com/p/snappy/>+--+-- These functions operate on strict bytestrings, and thus use as much+-- memory as both the entire compressed and uncompressed data.  module Codec.Compression.Snappy     (@@ -18,10 +21,10 @@     , decompress     ) where -import Control.Monad (unless)+import Codec.Compression.Snappy.Internal (check, maxCompressedLength) import Data.ByteString.Internal (ByteString(..), mallocByteString)-import Data.Word (Word8)-import Foreign.C.Types (CSize)+import Data.Word (Word8, Word32)+import Foreign.C.Types (CInt, CSize) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Utils (with)@@ -32,8 +35,8 @@  -- | Compress data into the Snappy format. compress :: ByteString -> ByteString-compress bs@(PS sfp off len) = unsafePerformIO $ do-  let dlen0 = fromIntegral . c_MaxCompressedLength . fromIntegral $ len+compress (PS sfp off len) = unsafePerformIO $ do+  let dlen0 = maxCompressedLength len   dfp <- mallocByteString dlen0   withForeignPtr sfp $ \sptr ->     withForeignPtr dfp $ \dptr ->@@ -51,23 +54,21 @@     let sptr = sptr0 `plusPtr` off         len = fromIntegral slen     alloca $ \dlenPtr -> do-      ok0 <- c_GetUncompressedLength sptr len dlenPtr-      unless ok0 $ error "Codec.Compression.Snappy.decompress: corrupt input"+      check "decompress" $ c_GetUncompressedLength sptr len dlenPtr       dlen <- fromIntegral `fmap` peek dlenPtr-      dfp <- mallocByteString dlen-      withForeignPtr dfp $ \dptr -> do-        ok1 <- c_RawUncompress sptr len dptr-        unless ok1 $ error "Codec.Compression.Snappy.decompress: corrupt input"-        return (PS dfp 0 dlen)--foreign import ccall unsafe "hs_snappy.h _hsnappy_MaxCompressedLength"-    c_MaxCompressedLength :: CSize -> CSize+      if dlen == 0+        then return B.empty+        else do+          dfp <- mallocByteString dlen+          withForeignPtr dfp $ \dptr -> do+            check "decompress" $ c_RawUncompress sptr len dptr+            return (PS dfp 0 dlen)  foreign import ccall unsafe "hs_snappy.h _hsnappy_RawCompress"     c_RawCompress :: Ptr a -> CSize -> Ptr Word8 -> Ptr CSize -> IO ()  foreign import ccall unsafe "hs_snappy.h _hsnappy_GetUncompressedLength"-    c_GetUncompressedLength :: Ptr a -> CSize -> Ptr CSize -> IO Bool+    c_GetUncompressedLength :: Ptr a -> CSize -> Ptr Word32 -> IO CInt  foreign import ccall unsafe "hs_snappy.h _hsnappy_RawUncompress"-    c_RawUncompress :: Ptr a -> CSize -> Ptr Word8 -> IO Bool+    c_RawUncompress :: Ptr a -> CSize -> Ptr Word8 -> IO CInt
+ Codec/Compression/Snappy/Internal.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- |+-- Module:      Codec.Compression.Snappy+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module provides fast, pure Haskell bindings to Google's+-- Snappy compression and decompression library:+-- <http://code.google.com/p/snappy/>+--+-- These functions operate on strict bytestrings, and thus use as much+-- memory as both the entire compressed and uncompressed data.++module Codec.Compression.Snappy.Internal+    (+      check+    , maxCompressedLength+    ) where++import Control.Monad (when)+import Foreign.C.Types (CSize)++maxCompressedLength :: Int -> Int+maxCompressedLength = fromIntegral . c_MaxCompressedLength . fromIntegral+{-# INLINE maxCompressedLength #-}++check :: (Integral a) => String -> IO a -> IO ()+check func act = do+  ok <- act+  when (ok == 0) . fail $ "Codec.Compression.Snappy." ++ func +++                          ": corrupt input "+{-# INLINE check #-}++foreign import ccall unsafe "hs_snappy.h _hsnappy_MaxCompressedLength"+    c_MaxCompressedLength :: CSize -> CSize
+ Codec/Compression/Snappy/Lazy.hsc view
@@ -0,0 +1,117 @@+{-# LANGUAGE BangPatterns, EmptyDataDecls, ForeignFunctionInterface #-}++-- |+-- Module:      Codec.Compression.Snappy+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- This module provides fast, pure zero-copy compression and+-- decompression of lazy 'ByteString' data using the Snappy format.+--+-- Although these functions operate on lazy 'ByteString's, they+-- consume the data /strictly/: they do not produce any output until+-- they have consumed all of the input, and they produce the output in+-- a single large chunk.+--+-- If your data is already in the form of a lazy 'ByteString', it is+-- likely more efficient to use these functions than to convert your+-- data to and from strict ByteStrings, as you can avoid the+-- additional allocation and copying that would entail.++module Codec.Compression.Snappy.Lazy+    (+      compress+    , decompress+    ) where++#include "hs_snappy.h"++import Codec.Compression.Snappy.Internal (check, maxCompressedLength)+import Control.Exception (bracket)+import Data.ByteString.Internal hiding (ByteString)+import Data.ByteString.Lazy.Internal (ByteString(..))+import Data.Word (Word8, Word32)+import Foreign.C.Types (CInt, CSize)+import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (withArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (Storable(..))+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++newtype BS = BS B.ByteString++data BSSource++instance Storable BS where+    sizeOf _    = (#size struct BS)+    alignment _ = alignment (undefined :: Ptr CInt)+    poke ptr (BS (PS fp off len)) = withForeignPtr fp $ \p -> do+      (#poke struct BS, ptr) ptr (p `plusPtr` off)+      (#poke struct BS, off) ptr (0::CSize)+      (#poke struct BS, len) ptr len+    {-# INLINE poke #-}++-- | Compress data into the Snappy format.+compress :: ByteString -> ByteString+compress bs = unsafePerformIO . withChunks bs $ \chunkPtr numChunks len -> do+  let dlen0 = maxCompressedLength len+  dfp <- mallocByteString dlen0+  withForeignPtr dfp $ \dptr -> do+    with (fromIntegral dlen0) $ \dlenPtr -> do+      c_CompressChunks chunkPtr (fromIntegral numChunks)+                       (fromIntegral len) dptr dlenPtr+      dlen <- fromIntegral `fmap` peek dlenPtr+      if dlen == 0+        then return Empty+        else return (Chunk (PS dfp 0 dlen) Empty)++-- | Decompress data in the Snappy format.+--+-- If the input is not compressed or is corrupt, an exception will be+-- thrown.+decompress :: ByteString -> ByteString+decompress bs = unsafePerformIO . withChunks bs $ \chunkPtr numChunks len ->+  bracket (c_NewSource chunkPtr (fromIntegral numChunks) (fromIntegral len))+          c_DeleteSource $ \srcPtr -> do+    alloca $ \dlenPtr -> do+      check "Lazy.decompress" $ c_GetUncompressedLengthChunks srcPtr dlenPtr+      dlen <- fromIntegral `fmap` peek dlenPtr+      if dlen == 0+        then return L.empty+        else do+          dfp <- mallocByteString dlen+          withForeignPtr dfp $ \dptr -> do+            check "Lazy.decompress" $ c_UncompressChunks srcPtr dptr+            return (Chunk (PS dfp 0 dlen) Empty)++withChunks :: ByteString -> (Ptr BS -> Int -> Int -> IO a) -> IO a+withChunks bs act = do+  let len = fromIntegral (L.length bs)+  let chunks = L.toChunks bs+  r <- withArray (map BS chunks) $ \chunkPtr ->+       act chunkPtr (length chunks) len+  foldr (\(PS fp _ _) _ -> touchForeignPtr fp) (return ()) chunks+  return r++foreign import ccall unsafe "hs_snappy.h _hsnappy_CompressChunks"+    c_CompressChunks :: Ptr BS -> CSize -> CSize -> Ptr Word8 -> Ptr CSize+                     -> IO ()++foreign import ccall unsafe "hs_snappy.h _hsnappy_NewSource"+    c_NewSource :: Ptr BS -> CSize -> CSize -> IO (Ptr BSSource)++foreign import ccall unsafe "hs_snappy.h _hsnappy_DeleteSource"+    c_DeleteSource :: Ptr BSSource -> IO ()++foreign import ccall unsafe "hs_snappy.h _hsnappy_UncompressChunks"+    c_UncompressChunks :: Ptr BSSource -> Ptr Word8 -> IO Int++foreign import ccall unsafe "hs_snappy.h _hsnappy_GetUncompressedLengthChunks"+    c_GetUncompressedLengthChunks :: Ptr BSSource -> Ptr Word32 -> IO Int
README.md view
@@ -4,6 +4,10 @@ using Google's Snappy format.  It is implemented as a binding to the [Snappy library](http://code.google.com/p/snappy/). +It implements zero-copy compression and decompression of both strict+and lazy [bytestring](http://hackage.haskell.org/package/bytestring)s,+the standard Haskell types for managing binary data efficiently.+ # Join in!  We are happy to receive bug reports, fixes, documentation enhancements,
cbits/hs_snappy.cpp view
@@ -1,26 +1,105 @@ #include "hs_snappy.h" #include "snappy.h"+#include "snappy-sinksource.h" +using namespace snappy;+ size_t _hsnappy_MaxCompressedLength(size_t n) {-  return snappy::MaxCompressedLength(n);+  return MaxCompressedLength(n); }  void _hsnappy_RawCompress(const char *input, size_t input_length, 			  char *compressed, size_t *compressed_length) {-  snappy::RawCompress(input, input_length, compressed, compressed_length);+  RawCompress(input, input_length, compressed, compressed_length); } -bool _hsnappy_GetUncompressedLength(const char *compressed,-				    size_t compressed_length,-				    size_t *result)+int _hsnappy_GetUncompressedLength(const char *compressed,+				   size_t compressed_length,+				   size_t *result) {-  return snappy::GetUncompressedLength(compressed, compressed_length, result);+  return GetUncompressedLength(compressed, compressed_length, result); } -bool _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,-			    char *uncompressed)+int _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,+			   char *uncompressed) {-  return snappy::RawUncompress(compressed, compressed_length, uncompressed);+  return RawUncompress(compressed, compressed_length, uncompressed);+}++class BSSource : public Source+{+public:+  BSSource(BS *chunks, size_t nchunks, size_t size)+    : chunks_(chunks), nchunks_(nchunks), size_(size), cur_(chunks),+      left_(size) { }++  size_t Available() const { return left_; }++  const char *Peek(size_t *len) {+    if (left_ > 0) {+      *len = cur_->len - cur_->off;+      return cur_->ptr + cur_->off;+    } else {+      *len = 0;+      return NULL;+    }+  }++  void Skip(size_t n) {+    if (n > 0) {+      left_ -= n;+      cur_->off += n;+      if (cur_->off == cur_->len)+	cur_++;+    }+  }++  void Rewind() {+    left_ = size_;+    cur_ = chunks_;+    for (size_t i = 0; i < nchunks_ && chunks_[i].off > 0; i++)+      chunks_[i].off = 0;+  }++private:+  BS *chunks_;+  const size_t nchunks_;+  const size_t size_;+  BS *cur_;+  size_t left_;+};++void _hsnappy_CompressChunks(BS *chunks, size_t nchunks, size_t length,+			     char *compressed, size_t *compressed_length)+{+  BSSource reader(chunks, nchunks, length);+  UncheckedByteArraySink writer(compressed);++  Compress(&reader, &writer);++  *compressed_length = writer.CurrentDestination() - compressed;+}++BSSource *_hsnappy_NewSource(BS *chunks, size_t nchunks, size_t length)+{+  return new BSSource(chunks, nchunks, length);+}++void _hsnappy_DeleteSource(BSSource *src)+{+  delete src;+}++int _hsnappy_UncompressChunks(BSSource *reader, char *uncompressed)+{+  return RawUncompress(reader, uncompressed);+}++int _hsnappy_GetUncompressedLengthChunks(BSSource *reader, uint32_t *result)+{+  int n = GetUncompressedLength(reader, result);+  reader->Rewind();+  return n; }
include/hs_snappy.h view
@@ -2,23 +2,48 @@ #define _hs_snappy_h  #include <stddef.h>+#include <stdint.h>  #ifdef __cplusplus-extern "C" +extern "C" { #endif +struct BS {+  const char *ptr;+  size_t off;+  size_t len;+};+ size_t _hsnappy_MaxCompressedLength(size_t);  void _hsnappy_RawCompress(const char *input, size_t input_length, 			  char *compressed, size_t *compressed_length); -bool _hsnappy_GetUncompressedLength(const char *compressed,-				    size_t compressed_length,-				    size_t *result);+int _hsnappy_GetUncompressedLength(const char *compressed,+				   size_t compressed_length,+				   size_t *result); -bool _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,-			    char *uncompressed);+int _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,+			   char *uncompressed);++struct BS;++void _hsnappy_CompressChunks(struct BS *chunks, size_t count,+			     size_t length, char *compressed,+			     size_t *compressed_length);++struct BSSource;++struct BSSource *_hsnappy_NewSource(struct BS *chunks, size_t nchunks,+				    size_t length);++void _hsnappy_DeleteSource(struct BSSource *reader);++int _hsnappy_UncompressChunks(struct BSSource *reader, char *uncompressed);++int _hsnappy_GetUncompressedLengthChunks(struct BSSource *reader,+					 uint32_t *result);  #ifdef __cplusplus }
snappy.cabal view
@@ -1,5 +1,5 @@ name:           snappy-version:        0.1.0.0+version:        0.2.0.0 homepage:       http://github.com/mailrank/snappy bug-reports:    http://github.com/mailrank/snappy/issues synopsis:@@ -20,18 +20,26 @@   include/hs_snappy.h   tests/Makefile   tests/Properties.hs+  tests/Snappy.hs  library   c-sources:       cbits/hs_snappy.cpp   include-dirs:    include   extra-libraries: snappy stdc++ -  build-depends:     base < 5, bytestring+  cc-options:      -Wall+  ghc-options:     -Wall++  build-depends:   base < 5, bytestring   if impl(ghc >= 6.10)-    build-depends:   base >= 4+    build-depends: base >= 4    exposed-modules:     Codec.Compression.Snappy+    Codec.Compression.Snappy.Lazy++  other-modules:+    Codec.Compression.Snappy.Internal  source-repository head   type:     git
tests/Makefile view
@@ -1,9 +1,13 @@ ghc := ghc+ghcflags := -threaded -O -all: qc+all: qc snappy  qc: Properties.hs-	$(ghc) --make -o $@ $^+	$(ghc) $(ghcflags) --make -o $@ $^ +snappy: Snappy.hs+	$(ghc) $(ghcflags) -O --make -o $@ $^+ clean:-	-rm -f qc *.o *.hi+	-rm -f qc snappy *.o *.hi
tests/Properties.hs view
@@ -1,14 +1,52 @@-import Codec.Compression.Snappy+{-# LANGUAGE FlexibleInstances #-}++import Control.Applicative+import qualified Codec.Compression.Snappy as B+import qualified Codec.Compression.Snappy.Lazy as L import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..)) import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L -roundtrip s = decompress (compress bs) == bs-  where bs = B.pack s+instance Arbitrary B.ByteString where+    arbitrary = B.pack <$> arbitrary +instance Arbitrary L.ByteString where+    arbitrary = rechunk <$> arbitrary <*> arbitrary++s_roundtrip bs = B.decompress (B.compress bs) == bs++newtype Compressed a = Compressed { compressed :: a }+    deriving (Eq, Ord)++instance Show a => Show (Compressed a)+    where show (Compressed a) = "Compressed " ++ show a++instance Arbitrary (Compressed B.ByteString) where+    arbitrary = (Compressed . B.compress) <$> arbitrary++compress_eq n bs = L.fromChunks [B.compress bs] == L.compress (rechunk n bs)+decompress_eq n bs0 =+    L.fromChunks [B.decompress bs] == L.decompress (rechunk n bs)+  where bs = B.compress bs0++rechunk :: Int -> B.ByteString -> L.ByteString+rechunk n = L.fromChunks . go+  where go bs | B.null bs = []+              | otherwise = case B.splitAt ((n `mod` 63) + 1) bs of+                              (x,y) -> x : go y++t_rechunk n bs = L.fromChunks [bs] == rechunk n bs++l_roundtrip bs = L.decompress (L.compress bs) == bs+ main = defaultMain tests  tests = [-    testProperty "roundtrip" roundtrip+    testProperty "s_roundtrip" s_roundtrip+  , testProperty "t_rechunk" t_rechunk+  , testProperty "compress_eq" compress_eq+  , testProperty "decompress_eq" decompress_eq+  , testProperty "l_roundtrip" l_roundtrip   ]
+ tests/Snappy.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings,+    RecordWildCards #-}++import Control.Exception+import Data.Maybe+import Control.Monad+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+import System.IO+import System.Exit+import qualified Codec.Compression.GZip as G+import qualified Codec.Compression.Snappy as S+import System.Console.CmdArgs+import Data.Data+import Data.Typeable+import Data.Time.Clock++data Codec = Snappy | GZip+             deriving (Eq, Show, Typeable, Data)++data Action = Compress | Decompress+              deriving (Eq, Show, Typeable, Data)++data Command = Command {+      action :: Action+    , codec :: Codec+    , level :: Maybe Int+    , number :: Maybe Int+    , files :: [FilePath]+    } deriving (Show, Typeable, Data)++command = Command { action = enum [Compress, Decompress]+                  , codec = enum [Snappy, GZip]+                  , level = def+                  , number = def+                  , files = def &= args+                  }++rnf (L.Chunk _ cs) = rnf cs+rnf _              = ()++snappy Command{..} f = do+  bs0 <- B.readFile f+  let bs | action == Compress = bs0+         | otherwise          = S.compress bs0+      count = fromMaybe (200000000 `div` B.length bs) number+      c !i s | i >= count = ()+             | otherwise  = S.compress s `seq` c (i+1) s+      d !i s | i >= count = ()+             | otherwise  = S.decompress s `seq` d (i+1) s+  start <- getCurrentTime+  evaluate $ if action == Compress then c 0 bs else d 0 bs+  time <- (fromRational . toRational . flip diffUTCTime start) `fmap`+          getCurrentTime+  return (fromIntegral (B.length bs) * fromIntegral count / (time * 1048576.0),+          (B.length (S.compress bs0) * 100) `div` B.length bs0)++gzip Command{..} f = do+  bs0 <- L.readFile f+  let bs | action == Compress = bs0+         | otherwise          = compress bs0+      compress = G.compressWith G.defaultCompressParams {+                   G.compressLevel = G.CompressionLevel $ fromMaybe 3 level+                 }+      len = L.length bs+      count = fromMaybe (25000000 `div` fromIntegral len) number+      c !i s | i >= count = ()+             | otherwise  = rnf (compress s) `seq` c (i+1) s+      d !i s | i >= count = ()+             | otherwise  = rnf (G.decompress s) `seq` d (i+1) s+  start <- getCurrentTime+  evaluate $ if action == Compress then c 0 bs else d 0 bs+  time <- (fromRational . toRational . flip diffUTCTime start) `fmap`+          getCurrentTime+  return (fromIntegral len * fromIntegral count / (time * 1048576.0),+          fromIntegral $ (L.length (compress bs0) * 100) `div` L.length bs0)++main = do+  c@Command{..} <- cmdArgs command+  forM_ files $ \f -> do+    (mbSec, ratio) <- (if codec == Snappy then snappy else gzip) c f+    putStrLn $ show codec ++ " " ++ show action ++ " " +++               show f ++ ": " ++ show (round mbSec) ++ " MB/sec, " +++               show (100 - ratio) ++ "% smaller"