diff --git a/Codec/Compression/Snappy.hs b/Codec/Compression/Snappy.hs --- a/Codec/Compression/Snappy.hs +++ b/Codec/Compression/Snappy.hs @@ -4,7 +4,7 @@ -- Module: Codec.Compression.Snappy -- Copyright: (c) 2011 MailRank, Inc. -- License: Apache --- Maintainer: Bryan O'Sullivan +-- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- diff --git a/Codec/Compression/Snappy/Internal.hs b/Codec/Compression/Snappy/Internal.hs --- a/Codec/Compression/Snappy/Internal.hs +++ b/Codec/Compression/Snappy/Internal.hs @@ -4,7 +4,7 @@ -- Module: Codec.Compression.Snappy -- Copyright: (c) 2011 MailRank, Inc. -- License: Apache --- Maintainer: Bryan O'Sullivan +-- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- diff --git a/Codec/Compression/Snappy/Lazy.hsc b/Codec/Compression/Snappy/Lazy.hsc --- a/Codec/Compression/Snappy/Lazy.hsc +++ b/Codec/Compression/Snappy/Lazy.hsc @@ -4,7 +4,7 @@ -- Module: Codec.Compression.Snappy -- Copyright: (c) 2011 MailRank, Inc. -- License: Apache --- Maintainer: Bryan O'Sullivan +-- Maintainer: Bryan O'Sullivan -- Stability: experimental -- Portability: portable -- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -14,11 +14,11 @@ and other improvements. Please report bugs via the -[github issue tracker](http://github.com/mailrank/snappy/issues). +[github issue tracker](http://github.com/bos/snappy/issues). -Master [git repository](http://github.com/mailrank/snappy): +Master [git repository](http://github.com/bos/snappy): -* `git clone git://github.com/mailrank/snappy.git` +* `git clone git://github.com/bos/snappy.git` There's also a [Mercurial mirror](http://bitbucket.org/bos/snappy): @@ -30,4 +30,4 @@ ------- This library is written and maintained by Bryan O'Sullivan, -. +. diff --git a/snappy.cabal b/snappy.cabal --- a/snappy.cabal +++ b/snappy.cabal @@ -1,7 +1,7 @@ name: snappy -version: 0.2.0.0 -homepage: http://github.com/mailrank/snappy -bug-reports: http://github.com/mailrank/snappy/issues +version: 0.2.0.1 +homepage: http://github.com/bos/snappy +bug-reports: http://github.com/bos/snappy/issues synopsis: Bindings to the Google Snappy library for fast compression/decompression description: @@ -9,18 +9,18 @@ compression and decompression library: license: BSD3 license-file: LICENSE -author: Bryan O'Sullivan -maintainer: Bryan O'Sullivan +author: Bryan O'Sullivan +maintainer: Bryan O'Sullivan copyright: Copyright 2011 MailRank, Inc. category: Codec, Compression build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.8 extra-source-files: README.md include/hs_snappy.h tests/Makefile tests/Properties.hs - tests/Snappy.hs + tests/Speedy.hs library c-sources: cbits/hs_snappy.cpp @@ -41,6 +41,28 @@ other-modules: Codec.Compression.Snappy.Internal +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Properties.hs + + ghc-options: + -Wall -threaded -O0 -rtsopts + + cpp-options: + -DASSERTS -DHAVE_DEEPSEQ + + build-depends: + base < 5, + bytestring, + cmdargs, + QuickCheck >= 2.4, + snappy, + test-framework, + test-framework-quickcheck2, + time, + zlib + source-repository head type: git - location: http://github.com/mailrank/snappy + location: http://github.com/bos/snappy diff --git a/tests/Makefile b/tests/Makefile --- a/tests/Makefile +++ b/tests/Makefile @@ -1,13 +1,18 @@ +pkgs := snappy + ghc := ghc -ghcflags := -threaded -O +ghcflags := -Wall -threaded -O -all: qc snappy +all: bm qc speedy -qc: Properties.hs +bm: Functions.hs Benchmarks.hs $(ghc) $(ghcflags) --make -o $@ $^ -snappy: Snappy.hs - $(ghc) $(ghcflags) -O --make -o $@ $^ +qc: Functions.hs Properties.hs + $(ghc) $(ghcflags) --make -o $@ $^ +speedy: Speedy.hs + $(ghc) $(ghcflags) --make -o $@ $^ + clean: - -rm -f qc snappy *.o *.hi + -rm -f bm qc speedy *.o *.hi diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,11 +1,13 @@ {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -import Control.Applicative -import qualified Codec.Compression.Snappy as B -import qualified Codec.Compression.Snappy.Lazy as L -import Test.Framework (defaultMain, testGroup) +import Control.Applicative ((<$>), (<*>)) +import Functions (rechunk) +import Test.Framework (defaultMain) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..)) +import qualified Codec.Compression.Snappy as B +import qualified Codec.Compression.Snappy.Lazy as L import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L @@ -13,7 +15,7 @@ arbitrary = B.pack <$> arbitrary instance Arbitrary L.ByteString where - arbitrary = rechunk <$> arbitrary <*> arbitrary + arbitrary = smallChunk <$> arbitrary <*> arbitrary s_roundtrip bs = B.decompress (B.compress bs) == bs @@ -26,20 +28,15 @@ 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 +compress_eq n bs = L.fromChunks [B.compress bs] == L.compress (smallChunk n bs) +decompress_eq n (Compressed bs) = + L.fromChunks [B.decompress bs] == L.decompress (smallChunk n bs) -t_rechunk n bs = L.fromChunks [bs] == rechunk n bs +t_rechunk n bs = L.fromChunks [bs] == smallChunk n bs l_roundtrip bs = L.decompress (L.compress bs) == bs + +smallChunk n = rechunk ((n `mod` 63) + 1) main = defaultMain tests diff --git a/tests/Snappy.hs b/tests/Snappy.hs deleted file mode 100644 --- a/tests/Snappy.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# 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" diff --git a/tests/Speedy.hs b/tests/Speedy.hs new file mode 100644 --- /dev/null +++ b/tests/Speedy.hs @@ -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"