1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Main (main) where
5
6import Criterion.Main
7
8import Prelude.Compat
9
10import Data.Foldable (toList)
11import qualified Data.Aeson as A
12import qualified Data.Sequence as S
13import qualified Data.Vector as V
14import qualified Data.Vector.Unboxed as U
15
16-------------------------------------------------------------------------------
17-- List
18-------------------------------------------------------------------------------
19
20newtype L f = L { getL :: f Int }
21
22instance Foldable f => A.ToJSON (L f) where
23    toJSON = error "do not use this"
24    toEncoding = A.toEncoding . toList . getL
25
26-------------------------------------------------------------------------------
27-- Foldable
28-------------------------------------------------------------------------------
29
30newtype F f = F { getF :: f Int }
31
32instance Foldable f => A.ToJSON (F f) where
33    toJSON = error "do not use this"
34    toEncoding = A.foldable . getF
35
36-------------------------------------------------------------------------------
37-- Values
38-------------------------------------------------------------------------------
39
40valueList :: [Int]
41valueList = [1..1000]
42
43valueSeq :: S.Seq Int
44valueSeq = S.fromList valueList
45
46valueVector :: V.Vector Int
47valueVector = V.fromList valueList
48
49valueUVector :: U.Vector Int
50valueUVector = U.fromList valueList
51
52-------------------------------------------------------------------------------
53-- Main
54-------------------------------------------------------------------------------
55
56benchEncode
57    :: A.ToJSON a
58    => String
59    -> a
60    -> Benchmark
61benchEncode name val
62    = bench ("A " ++ name) $ nf A.encode val
63
64main :: IO ()
65main =  defaultMain
66    [ bgroup "encode"
67        [ bgroup "List"
68            [ benchEncode "-"     valueList
69            , benchEncode "L" $ L valueList
70            , benchEncode "F" $ F valueList
71            ]
72        , bgroup "Seq"
73            [ benchEncode "-"     valueSeq
74            , benchEncode "L" $ L valueSeq
75            , benchEncode "F" $ F valueSeq
76            ]
77        , bgroup "Vector"
78            [ benchEncode "-"     valueVector
79            , benchEncode "L" $ L valueVector
80            , benchEncode "F" $ F valueVector
81            ]
82        , bgroup "Vector.Unboxed"
83            [ benchEncode "-"     valueUVector
84            ]
85        ]
86    ]
87