Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Benchmark compression functions over pure and impure inputs

  • Loading branch information...
commit f9f556e031f45dd0601277e86e224016e4bc8a18 1 parent c8298d3
@bos authored
View
2  .hgignore
@@ -1,6 +1,6 @@
^(?:dist|\.DS_Store)$
.*\.(?:aux|dSYM|h[ip]|o|orig|out|pdf|prof|ps|rej)$
-^tests/(?:qc|speedy)$
+^tests/(?:bm|qc|speedy)$
syntax: glob
*~
View
67 tests/Benchmarks.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+import Control.DeepSeq (NFData(..))
+import Control.Exception (finally)
+import Criterion.Main
+import Functions (rechunk)
+import System.Directory (getTemporaryDirectory, removeFile)
+import System.IO (hClose, openBinaryTempFile)
+import qualified Codec.Compression.Snappy as S
+import qualified Codec.Compression.Snappy.Lazy as L
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Internal as L
+
+strictCompressFile name = do
+ bs <- S.readFile name
+ return $! S.compress bs
+
+lazyCompressFile name = do
+ bs <- L.readFile name
+ return $! rnf (L.compress bs)
+
+strictDecompressFile name = do
+ bs <- S.readFile name
+ return $! S.decompress bs
+
+lazyDecompressFile name = do
+ bs <- L.readFile name
+ return $! rnf (L.decompress bs)
+
+instance NFData L.ByteString where
+ rnf (L.Chunk _ cs) = rnf cs
+ rnf _ = ()
+ {-# INLINE rnf #-}
+
+main = do
+ let rawName = "test-data/huge.json"
+ tmpDir <- getTemporaryDirectory
+ (compName, h) <- openBinaryTempFile tmpDir "compressed"
+ sraw <- S.readFile rawName
+ let scomp = S.compress sraw
+ lraw = rechunk 16384 sraw
+ lcomp = rechunk 16384 scomp
+ S.hPut h scomp
+ hClose h
+ flip finally (removeFile compName) $ defaultMain [
+ bgroup "file" [
+ bgroup "compress" [
+ bench "strict" $ strictCompressFile rawName
+ , bench "lazy" $ lazyCompressFile rawName
+ ]
+ , bgroup "decompress" [
+ bench "strict" $ strictDecompressFile compName
+ , bench "lazy" $ lazyDecompressFile compName
+ ]
+ ]
+ , bgroup "pure" [
+ bgroup "compress" [
+ bench "strict" $ whnf S.compress sraw
+ , bench "lazy" $ nf L.compress lraw
+ ]
+ , bgroup "decompress" [
+ bench "strict" $ whnf S.decompress scomp
+ , bench "lazy" $ nf L.decompress lcomp
+ ]
+ ]
+ ]
View
15 tests/Functions.hs
@@ -0,0 +1,15 @@
+module Functions
+ (
+ rechunk
+ ) where
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+
+rechunk :: Int -> B.ByteString -> L.ByteString
+rechunk n
+ | n <= 0 = error "rechunk: wtf!?"
+ | otherwise = L.fromChunks . go
+ where go bs | B.null bs = []
+ | otherwise = case B.splitAt n bs of
+ (x,y) -> x : go y
View
15 tests/Makefile
@@ -1,13 +1,18 @@
+pkgs := snappy
+
ghc := ghc
-ghcflags := -threaded -O
+ghcflags := -Wall -threaded -O
+
+all: bm qc speedy
-all: qc speedy
+bm: Functions.hs Benchmarks.hs
+ $(ghc) $(ghcflags) --make -o $@ $^
-qc: Properties.hs
+qc: Functions.hs Properties.hs
$(ghc) $(ghcflags) --make -o $@ $^
speedy: Speedy.hs
- $(ghc) $(ghcflags) -O --make -o $@ $^
+ $(ghc) $(ghcflags) --make -o $@ $^
clean:
- -rm -f qc speedy *.o *.hi
+ -rm -f bm qc speedy *.o *.hi
View
26 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 @@ instance Arbitrary B.ByteString where
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,16 @@ instance Show a => Show (Compressed 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)
+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 (rechunk n bs)
-
-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
+ 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
tests = [
View
1  tests/test-data/huge.json
1 addition, 0 deletions not shown
Please sign in to comment.
Something went wrong with that request. Please try again.