Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial commit

  • Loading branch information...
commit ca7e79ec1f4b7bb3616e4d66408cbbab5a7d6840 0 parents
@bos authored
9 .hgignore
@@ -0,0 +1,9 @@
+^(?:dist|\.DS_Store)$
+.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
+^tests/(?:qc)$
+
+syntax: glob
+*~
+.*.swp
+.\#*
+\#*
56 Codec/Compression/Snappy.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Codec.Compression.Snappy
+ (
+ compress
+ , decompress
+ ) where
+
+import Control.Monad (unless)
+import Data.ByteString.Internal (ByteString(..), mallocByteString)
+import Data.Word (Word8)
+import Foreign.C.Types (CSize)
+import Foreign.ForeignPtr (withForeignPtr)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr (Ptr, plusPtr)
+import Foreign.Storable (peek)
+import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.ByteString as B
+
+compress :: ByteString -> ByteString
+compress bs@(PS sfp off len) = unsafePerformIO $ do
+ let dlen0 = fromIntegral . c_MaxCompressedLength . fromIntegral $ len
+ dfp <- mallocByteString dlen0
+ withForeignPtr sfp $ \sptr ->
+ withForeignPtr dfp $ \dptr ->
+ with (fromIntegral dlen0) $ \dlenPtr -> do
+ c_RawCompress (sptr `plusPtr` off) (fromIntegral len) dptr dlenPtr
+ (PS dfp 0 . fromIntegral) `fmap` peek dlenPtr
+
+decompress :: ByteString -> ByteString
+decompress (PS sfp off slen) = unsafePerformIO $
+ withForeignPtr sfp $ \sptr0 -> do
+ 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"
+ 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
+
+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
+
+foreign import ccall unsafe "hs_snappy.h _hsnappy_RawUncompress"
+ c_RawUncompress :: Ptr a -> CSize -> Ptr Word8 -> IO Bool
29 LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2011, MailRank Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above
+copyright notice, this list of conditions and the following disclaimer
+in the documentation and/or other materials provided with the
+distribution.
+ * Neither the name of MailRank Inc. nor the names of its
+contributors may be used to endorse or promote products derived
+from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
26 cbits/hs_snappy.cpp
@@ -0,0 +1,26 @@
+#include "hs_snappy.h"
+#include "snappy.h"
+
+size_t _hsnappy_MaxCompressedLength(size_t n)
+{
+ return snappy::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);
+}
+
+bool _hsnappy_GetUncompressedLength(const char *compressed,
+ size_t compressed_length,
+ size_t *result)
+{
+ return snappy::GetUncompressedLength(compressed, compressed_length, result);
+}
+
+bool _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,
+ char *uncompressed)
+{
+ return snappy::RawUncompress(compressed, compressed_length, uncompressed);
+}
27 include/hs_snappy.h
@@ -0,0 +1,27 @@
+#ifndef _hs_snappy_h
+#define _hs_snappy_h
+
+#include <stddef.h>
+
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+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);
+
+bool _hsnappy_RawUncompress(const char *compressed, size_t compressed_length,
+ char *uncompressed);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _hs_snappy_h */
36 snappy.cabal
@@ -0,0 +1,36 @@
+name: snappy
+version: 0.1.0.0
+homepage: http://github.com/mailrank/snappy
+bug-reports: http://github.com/mailrank/snappy/issues
+synopsis:
+ Bindings to the Google Snappy library for fast compression/decompression
+description:
+ This library provides efficient Haskell bindings to Google's Snappy
+ compression and decompression library.
+license: BSD3
+license-file: LICENSE
+author: Bryan O'Sullivan <bos@mailrank.com>
+maintainer: Bryan O'Sullivan <bos@mailrank.com>
+copyright: Copyright 2011 MailRank, Inc.
+category: Codec, Compression
+build-type: Simple
+cabal-version: >= 1.6
+extra-source-files:
+ tests/Makefile
+ tests/Properties.hs
+
+library
+ c-sources: cbits/hs_snappy.cpp
+ include-dirs: include
+ extra-libraries: snappy stdc++
+
+ build-depends: base < 5, bytestring
+ if impl(ghc >= 6.10)
+ build-depends: base >= 4
+
+ exposed-modules:
+ Codec.Compression.Snappy
+
+source-repository head
+ type: git
+ location: http://github.com/mailrank/snappy
9 tests/Makefile
@@ -0,0 +1,9 @@
+ghc := ghc
+
+all: qc
+
+qc: Properties.hs
+ $(ghc) --make -o $@ $^
+
+clean:
+ -rm -f qc *.o *.hi
14 tests/Properties.hs
@@ -0,0 +1,14 @@
+import Codec.Compression.Snappy
+import Test.Framework (defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck (Arbitrary(..))
+import qualified Data.ByteString as B
+
+roundtrip s = decompress (compress bs) == bs
+ where bs = B.pack s
+
+main = defaultMain tests
+
+tests = [
+ testProperty "roundtrip" roundtrip
+ ]
Please sign in to comment.
Something went wrong with that request. Please try again.