@@ -0,0 +1,87 @@
1+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
2+
3+module Main where
4+
5+--------------------------------------------------------------------------------
6+
7+import Criterion.Main
8+
9+import Control.DeepSeq (NFData, rnf, deepseq)
10+
11+import Data.Typeable (Typeable)
12+import Data.Data (Data)
13+import GHC.Generics (Generic)
14+
15+import Data.Aeson.Types
16+import Data.Aeson.TH (mkToJSON, mkParseJSON)
17+import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
18+
19+--------------------------------------------------------------------------------
20+
21+-- Taken from the documentation of Data.Aeson.TH:
22+data D a = Nullary
23+ | Unary Int
24+ | Product String Char a
25+ | Record { testOne :: Double
26+ , testTwo :: Bool
27+ , testThree :: D a
28+ } deriving (Eq, Generic, Data, Typeable)
29+
30+instance NFData a => NFData (D a) where
31+ rnf Nullary = ()
32+ rnf (Unary n) = rnf n
33+ rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
34+ rnf (Record d b y) = d `deepseq` b `deepseq` rnf y
35+
36+--------------------------------------------------------------------------------
37+
38+type T = D (D (D ()))
39+
40+d :: T
41+d = Record
42+ { testOne = 1234.56789
43+ , testTwo = True
44+ , testThree = Product "Hello World!" 'a' $
45+ Record
46+ { testOne = 9876.54321
47+ , testTwo = False
48+ , testThree = Product "Yeehaa!!!" '\n' Nullary
49+ }
50+ }
51+
52+--------------------------------------------------------------------------------
53+
54+instance ToJSON a => ToJSON (D a)
55+instance FromJSON a => FromJSON (D a)
56+
57+--------------------------------------------------------------------------------
58+
59+thToJSON :: ToJSON a => D a -> Value
60+thToJSON = $(mkToJSON id ''D)
61+
62+thParseJSON :: FromJSON a => Value -> Parser (D a)
63+thParseJSON = $(mkParseJSON id ''D)
64+
65+thFromJSON :: FromJSON a => Value -> Result (D a)
66+thFromJSON = parse thParseJSON
67+
68+--------------------------------------------------------------------------------
69+
70+type FJ = Value -> Result T
71+
72+main :: IO ()
73+main =
74+ let v = thToJSON d
75+ in d `deepseq` v `deepseq` defaultMain
76+ [ group "toJSON" (nf thToJSON d)
77+ (nf G.toJSON d)
78+ (nf toJSON d)
79+ , group "fromJSON" (nf (thFromJSON :: FJ) v)
80+ (nf (G.fromJSON :: FJ) v)
81+ (nf (fromJSON :: FJ) v)
82+ ]
83+
84+group n th syb gen = bgroup n [ bench "th" th
85+ , bench "syb" syb
86+ , bench "generic" gen
87+ ]