diff options
Diffstat (limited to 'bench/serialization.hs')
-rw-r--r-- | bench/serialization.hs | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/bench/serialization.hs b/bench/serialization.hs new file mode 100644 index 00000000..31b5b0bf --- /dev/null +++ b/bench/serialization.hs | |||
@@ -0,0 +1,41 @@ | |||
1 | {-# OPTIONS -fno-warn-orphans #-} | ||
2 | module Main (main) where | ||
3 | |||
4 | import Control.Applicative | ||
5 | import Control.DeepSeq | ||
6 | import Criterion.Main | ||
7 | import Data.ByteString (ByteString) | ||
8 | import Data.Serialize | ||
9 | import Network.Torrent.PWP | ||
10 | |||
11 | |||
12 | instance NFData BlockIx where | ||
13 | rnf (BlockIx a b c) = a `deepseq` b `deepseq` rnf c | ||
14 | |||
15 | instance NFData Block where | ||
16 | rnf (Block a b c) = a `deepseq` b `deepseq` rnf c | ||
17 | |||
18 | instance NFData Message where | ||
19 | rnf (Have i) = rnf i | ||
20 | rnf (Bitfield b) = rnf b | ||
21 | rnf (Request b) = rnf b | ||
22 | rnf (Piece b) = rnf b | ||
23 | rnf (Cancel b) = rnf b | ||
24 | rnf (Port i) = rnf i | ||
25 | rnf _ = () -- other fields are forced by pattern matching | ||
26 | |||
27 | encodeMessages :: [Message] -> ByteString | ||
28 | encodeMessages xs = runPut (mapM_ put xs) | ||
29 | |||
30 | decodeMessages :: ByteString -> Either String [Message] | ||
31 | decodeMessages = runGet (many get) | ||
32 | |||
33 | main :: IO () | ||
34 | main = do | ||
35 | let datas = replicate 100000 (Request (BlockIx 0 0 0)) | ||
36 | |||
37 | defaultMain | ||
38 | [ datas `deepseq` bench "message/encode" $ nf encodeMessages datas | ||
39 | , let binary = encodeMessages datas in | ||
40 | binary `deepseq` bench "message/decode" $ nf decodeMessages binary | ||
41 | ] \ No newline at end of file | ||