store-0.4.0: bench/Bench.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE DeriveDataTypeable #-}
import Control.Applicative ((<$>), (<*>), (*>))
#endif
import Control.DeepSeq
import Criterion.Main
import qualified Data.ByteString as BS
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Store
import Data.Typeable
import qualified Data.Vector as V
import qualified Data.Vector.Storable as SV
import Data.Word
import GHC.Generics
-- TODO: add packer
#if COMPARISON_BENCH
import qualified Data.Binary as Binary
import qualified Data.Serialize as Cereal
import qualified Data.ByteString.Lazy as BL
import Data.Vector.Serialize ()
#endif
data SomeData = SomeData !Int64 !Word8 !Double
deriving (Eq, Show, Generic, Typeable)
instance NFData SomeData where
rnf x = x `seq` ()
instance Store SomeData
#if COMPARISON_BENCH
instance Cereal.Serialize SomeData
instance Binary.Binary SomeData
#endif
main :: IO ()
main = do
#if SMALL_BENCH
let is = 0::Int
sds = SomeData 1 1 1
smallprods = (SmallProduct 0 1 2 3)
smallmanualprods = (SmallProductManual 0 1 2 3)
sss = [SS1 1, SS2 2, SS3 3, SS4 4]
ssms = [SSM1 1, SSM2 2, SSM3 3, SSM4 4]
nestedTuples = ((1,2),(3,4)) :: ((Int,Int),(Int,Int))
#else
let is = V.enumFromTo 1 100 :: V.Vector Int
sds = (\i -> SomeData i (fromIntegral i) (fromIntegral i))
<$> V.enumFromTo 1 100
smallprods = (\ i -> SmallProduct i (i+1) (i+2) (i+3))
<$> V.enumFromTo 1 100
smallmanualprods = (\ i -> SmallProductManual i (i+1) (i+2) (i+3))
<$> V.enumFromTo 1 100
sss = (\i -> case i `mod` 4 of
0 -> SS1 (fromIntegral i)
1 -> SS2 (fromIntegral i)
2 -> SS3 (fromIntegral i)
3 -> SS4 (fromIntegral i)
_ -> error "This does not compute."
) <$> V.enumFromTo 1 (100 :: Int)
ssms = (\i -> case i `mod` 4 of
0 -> SSM1 (fromIntegral i)
1 -> SSM2 (fromIntegral i)
2 -> SSM3 (fromIntegral i)
3 -> SSM4 (fromIntegral i)
_ -> error "This does not compute."
) <$> V.enumFromTo 1 (100 :: Int)
nestedTuples = (\i -> ((i,i+1),(i+2,i+3))) <$> V.enumFromTo (1::Int) 100
ints = [1..100] :: [Int]
pairs = map (\x -> (x, x)) ints
strings = show <$> ints
intsSet = Set.fromDistinctAscList ints
intSet = IntSet.fromDistinctAscList ints
intsMap = Map.fromDistinctAscList pairs
intMap = IntMap.fromDistinctAscList pairs
stringsSet = Set.fromList strings
stringsMap = Map.fromList (zip strings ints)
#endif
defaultMain
[ bgroup "encode"
[ benchEncode is
#if !SMALL_BENCH
, benchEncode' "1kb storable" (SV.fromList ([1..256] :: [Int32]))
, benchEncode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))
, benchEncode' "1kb normal" (V.fromList ([1..256] :: [Int32]))
, benchEncode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))
, benchEncode intsSet
, benchEncode intSet
, benchEncode intsMap
, benchEncode intMap
, benchEncode stringsSet
, benchEncode stringsMap
#endif
, benchEncode smallprods
, benchEncode smallmanualprods
, benchEncode sss
, benchEncode ssms
, benchEncode nestedTuples
, benchEncode sds
]
, bgroup "decode"
[ benchDecode is
#if !SMALL_BENCH
, benchDecode' "1kb storable" (SV.fromList ([1..256] :: [Int32]))
, benchDecode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))
, benchDecode' "1kb normal" (V.fromList ([1..256] :: [Int32]))
, benchDecode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))
, benchDecode intsSet
, benchDecode intSet
, benchDecode intsMap
, benchDecode intMap
, benchDecode stringsSet
, benchDecode stringsMap
#endif
, benchDecode smallprods
, benchDecode smallmanualprods
, benchDecode sss
, benchDecode ssms
, benchDecode nestedTuples
, benchDecode sds
]
]
type Ctx a =
( Store a, Typeable a, NFData a
#if COMPARISON_BENCH
, Binary.Binary a
, Cereal.Serialize a
#endif
)
benchEncode :: Ctx a => a -> Benchmark
benchEncode = benchEncode' ""
benchEncode' :: Ctx a => String -> a -> Benchmark
benchEncode' msg x0 =
env (return x0) $ \x ->
let label = msg ++ " (" ++ show (typeOf x0) ++ ")"
benchStore name = bench name (nf encode x) in
#if COMPARISON_BENCH
bgroup label
[ benchStore "store"
, bench "cereal" (nf Cereal.encode x)
, bench "binary" (nf Binary.encode x)
]
#else
benchStore label
#endif
benchDecode :: Ctx a => a -> Benchmark
benchDecode = benchDecode' ""
-- TODO: comparison bench for decode
benchDecode' :: forall a. Ctx a => String -> a -> Benchmark
#if COMPARISON_BENCH
benchDecode' prefix x0 =
bgroup label
[ env (return (encode x0)) $ \x -> bench "store" (nf (decodeEx :: BS.ByteString -> a) x)
, env (return (Cereal.encode x0)) $ \x -> bench "cereal" (nf ((ensureRight . Cereal.decode) :: BS.ByteString -> a) x)
, env (return (Binary.encode x0)) $ \x -> bench "binary" (nf (Binary.decode :: BL.ByteString -> a) x)
]
where
label = prefix ++ " (" ++ show (typeOf x0) ++ ")"
ensureRight (Left x) = error "left!"
ensureRight (Right x) = x
#else
benchDecode' prefix x0 =
env (return (encode x0)) $ \x ->
bench (prefix ++ " (" ++ show (typeOf x0) ++ ")") (nf (decodeEx :: BS.ByteString -> a) x)
#endif
------------------------------------------------------------------------
-- Serialized datatypes
data SmallProduct = SmallProduct Int32 Int32 Int32 Int32
deriving (Generic, Show, Typeable)
instance NFData SmallProduct
instance Store SmallProduct
data SmallProductManual = SmallProductManual Int32 Int32 Int32 Int32
deriving (Generic, Show, Typeable)
instance NFData SmallProductManual
instance Store SmallProductManual where
size = ConstSize 16
peek = SmallProductManual <$> peek <*> peek <*> peek <*> peek
poke (SmallProductManual a b c d) = poke a *> poke b *> poke c *> poke d
data SmallSum
= SS1 Int8
| SS2 Int32
| SS3 Int64
| SS4 Word32
deriving (Generic, Show, Typeable)
instance NFData SmallSum
instance Store SmallSum
data SmallSumManual
= SSM1 Int8
| SSM2 Int32
| SSM3 Int64
| SSM4 Word32
deriving (Generic, Show, Typeable)
instance NFData SmallSumManual
instance Store SmallSumManual where
size = VarSize $ \x -> 1 + case x of
SSM1{} -> 1
SSM2{} -> 4
SSM3{} -> 8
SSM4{} -> 4
peek = do
tag <- peek
case tag :: Word8 of
0 -> SSM1 <$> peek
1 -> SSM2 <$> peek
2 -> SSM3 <$> peek
3 -> SSM4 <$> peek
_ -> fail "Invalid tag"
poke (SSM1 x) = poke (0 :: Word8) >> poke x
poke (SSM2 x) = poke (1 :: Word8) >> poke x
poke (SSM3 x) = poke (2 :: Word8) >> poke x
poke (SSM4 x) = poke (3 :: Word8) >> poke x
-- TODO: add TH generation of the above, and add LargeSum / LargeProduct cases
#if COMPARISON_BENCH
instance Binary.Binary SmallProduct
instance Binary.Binary SmallSum
instance Cereal.Serialize SmallProduct
instance Cereal.Serialize SmallSum
instance Binary.Binary SmallProductManual where
get = SmallProductManual <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get
put (SmallProductManual a b c d) = Binary.put a *> Binary.put b *> Binary.put c *> Binary.put d
instance Binary.Binary SmallSumManual where
get = do
tag <- Binary.get
case tag :: Word8 of
0 -> SSM1 <$> Binary.get
1 -> SSM2 <$> Binary.get
2 -> SSM3 <$> Binary.get
3 -> SSM4 <$> Binary.get
_ -> fail "Invalid tag"
put (SSM1 x) = Binary.put (0 :: Word8) *> Binary.put x
put (SSM2 x) = Binary.put (1 :: Word8) *> Binary.put x
put (SSM3 x) = Binary.put (2 :: Word8) *> Binary.put x
put (SSM4 x) = Binary.put (3 :: Word8) *> Binary.put x
instance Cereal.Serialize SmallProductManual where
get = SmallProductManual <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get
put (SmallProductManual a b c d) = Cereal.put a *> Cereal.put b *> Cereal.put c *> Cereal.put d
instance Cereal.Serialize SmallSumManual where
get = do
tag <- Cereal.get
case tag :: Word8 of
0 -> SSM1 <$> Cereal.get
1 -> SSM2 <$> Cereal.get
2 -> SSM3 <$> Cereal.get
3 -> SSM4 <$> Cereal.get
_ -> fail "Invalid tag"
put (SSM1 x) = Cereal.put (0 :: Word8) *> Cereal.put x
put (SSM2 x) = Cereal.put (1 :: Word8) *> Cereal.put x
put (SSM3 x) = Cereal.put (2 :: Word8) *> Cereal.put x
put (SSM4 x) = Cereal.put (3 :: Word8) *> Cereal.put x
#endif