snappy-hs-0.1.2.0: benchmark/Main.hs

{-# LANGUAGE OverloadedStrings #-}

import qualified Codec.Compression.Snappy as Native
import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Criterion.Main
import qualified Data.ByteString as BS
import Data.Either (fromRight)
import qualified Snappy as Hs

-- | Keep in sync with @benchmark/Bench.hs@.
corpus :: [(String, FilePath)]
corpus =
    [ ("newton",    "./data/Isaac.Newton-Opticks.txt")
    , ("html",      "./data/html")
    , ("alice29",   "./data/alice29.txt")
    , ("protodata", "./data/geo.protodata")
    , ("urls",      "./data/urls.10K")
    , ("jpeg",      "./data/fireworks.jpeg")
    ]

main :: IO ()
main = do
    cases <- mapM loadCase corpus
    defaultMain
        [ bgroup name
            [ bgroup "compress"
                [ bench "hs"     $ whnf (BS.length . Hs.compress) src
                , bench "native" $ whnf (BS.length . Native.compress) src
                ]
            , bgroup "decompress"
                [ bench "hs"     $ whnf (BS.length . fromRight BS.empty . Hs.decompress) hsC
                , bench "native" $ whnf (BS.length . Native.decompress) natC
                ]
            ]
        | (name, src, hsC, natC) <- cases
        ]
  where
    loadCase (name, path) = do
        src  <- BS.readFile path
        hsC  <- evaluate (force (Hs.compress src))
        natC <- evaluate (force (Native.compress src))
        pure (name, src, hsC, natC)