summaryrefslogtreecommitdiff
path: root/bench/Main.hs
blob: cc64d4b5c59e636415a566680f5e81e690462ae2 (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
58
59
60
61
62
63
64
65
66
67
{-# LANGUAGE PackageImports #-}
module Main (main) where

import Control.DeepSeq
import Data.Maybe
import Data.Attoparsec.ByteString as Atto
import Data.ByteString as B
import Data.ByteString.Lazy as BL
import Criterion.Main
import System.Environment

import "bencode"   Data.BEncode     as A
import             Data.AttoBencode as B
import             Data.AttoBencode.Parser as B
import "bencoding" Data.BEncode     as C

instance NFData A.BEncode where
    rnf (A.BInt    i) = rnf i
    rnf (A.BString s) = rnf s
    rnf (A.BList   l) = rnf l
    rnf (A.BDict   m) = rnf m

instance NFData B.BValue where
    rnf (B.BInt    i) = rnf i
    rnf (B.BString s) = rnf s
    rnf (B.BList   l) = rnf l
    rnf (B.BDict   d) = rnf d

instance NFData C.BEncode where
    rnf (C.BInteger i) = rnf i
    rnf (C.BString  s) = rnf s
    rnf (C.BList    l) = rnf l
    rnf (C.BDict    d) = rnf d

getRight :: Either String a -> a
getRight (Left e) = error e
getRight (Right x) = x

main :: IO ()
main = do
  (path : args) <- getArgs
  torrentFile   <- B.readFile path
  let lazyTorrentFile = fromChunks [torrentFile]

  case rnf (torrentFile, lazyTorrentFile) of
    () -> return ()

  withArgs args $
       defaultMain
       [ bench "decode/bencode"     $ nf A.bRead                            lazyTorrentFile
       , bench "decode/AttoBencode" $ nf (getRight . Atto.parseOnly bValue) torrentFile
       , bench "decode/bencoding"   $ nf (getRight . C.decode)              torrentFile

       , let Just v = A.bRead lazyTorrentFile in
         bench "encode/bencode"     $ nf A.bPack v
       , let Right v = Atto.parseOnly bValue torrentFile in
         bench "encode/AttoBencode" $ nf B.encode v
       , let Right v = C.decode torrentFile in
         bench "encode/bencoding"   $ nf C.encode v

       , bench "decode+encode/bencode"     $ nf (A.bPack  . fromJust . A.bRead)
               lazyTorrentFile
       , bench "decode+encode/AttoBencode" $ nf (B.encode . getRight . Atto.parseOnly bValue)
               torrentFile
       , bench "decode+encode/bencoding"   $ nf (C.encode . getRight . C.decode)
               torrentFile
       ]