summaryrefslogtreecommitdiff
path: root/bench/Main.hs
blob: 4ce7c81831964f1944a6011125847889ded15034 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# OPTIONS -fno-warn-orphans #-}
module Main (main) where

import Control.Applicative
import Control.DeepSeq
import Criterion.Main
import Data.ByteString (ByteString)
import Data.Serialize
import Network.BitTorrent as BT


instance NFData BlockIx where
  rnf (BlockIx a b c) = a `deepseq` b `deepseq` rnf c

instance NFData Block where
  rnf (Block a b c) = a `deepseq` b `deepseq` rnf c

instance NFData Bitfield where
  rnf = rnf . bfBits

instance NFData Message where
  rnf (Have i)     = rnf i
  rnf (Bitfield b) = rnf b
  rnf (Request  b) = rnf b
  rnf (Piece    b) = rnf b
  rnf (Cancel   b) = rnf b
  rnf (Port     i) = rnf i
  rnf _ = ()  -- other fields are forced by pattern matching

encodeMessages :: [Message] -> ByteString
encodeMessages xs = runPut (mapM_ put xs)

decodeMessages :: ByteString -> Either String [Message]
decodeMessages = runGet (many get)

bitfieldDiff :: Int -> Bitfield
bitfieldDiff n = BT.empty n `difference` BT.empty n

bitfieldMin :: Int -> Maybe Int
bitfieldMin n = findMin (BT.empty n)

bitfieldMax :: Int -> Maybe Int
bitfieldMax n = findMax (BT.empty n)

main :: IO ()
main = do
  let datas = replicate 10000 (Request (BlockIx 0 0 0))

  defaultMain
    [ datas `deepseq` bench "message/encode"   $ nf encodeMessages datas
    , let binary = encodeMessages datas in
      binary `deepseq` bench "message/decode"  $ nf decodeMessages binary

    , bench "bitfield/difference"  $ nf bitfieldDiff 1000000
    , bench "bitfield/min"         $ nf bitfieldMin  10000000
    , bench "bitfield/max"         $ nf bitfieldMax  10000000
    ]