aeson-0.6.2.0: benchmarks/AesonCompareAutoInstances.hs
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
module Main where
--------------------------------------------------------------------------------
import Criterion.Main hiding (defaultOptions)
import Control.DeepSeq (NFData, rnf, deepseq)
import Data.Typeable (Typeable)
import Data.Data (Data)
import GHC.Generics (Generic)
import Data.Aeson.Types
import Data.Aeson.TH
import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
import Data.Aeson.Encode
import Options
--------------------------------------------------------------------------------
data D a = Nullary
| Unary Int
| Product String Char a
| Record { testOne :: Double
, testTwo :: Bool
, testThree :: D a
}
deriving (Show, Eq, Data, Typeable)
deriveJSON opts ''D
instance NFData a => NFData (D a) where
rnf Nullary = ()
rnf (Unary n) = rnf n
rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
rnf (Record d b y) = d `deepseq` b `deepseq` rnf y
type T = D (D (D ()))
d :: T
d = Record
{ testOne = 1234.56789
, testTwo = True
, testThree = Product "Hello World!" 'a' $
Record
{ testOne = 9876.54321
, testTwo = False
, testThree = Product "Yeehaa!!!" '\n' Nullary
}
}
--------------------------------------------------------------------------------
data D' a = Nullary'
| Unary' Int
| Product' String Char a
| Record' { testOne' :: Double
, testTwo' :: Bool
, testThree' :: D' a
}
deriving (Show, Eq, Generic, Data, Typeable)
instance ToJSON a => ToJSON (D' a) where
toJSON = genericToJSON opts
instance FromJSON a => FromJSON (D' a) where
parseJSON = genericParseJSON opts
instance NFData a => NFData (D' a) where
rnf Nullary' = ()
rnf (Unary' n) = rnf n
rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y
type T' = D' (D' (D' ()))
d' :: T'
d' = Record'
{ testOne' = 1234.56789
, testTwo' = True
, testThree' = Product' "Hello World!" 'a' $
Record'
{ testOne' = 9876.54321
, testTwo' = False
, testThree' = Product' "Yeehaa!!!" '\n' Nullary'
}
}
--------------------------------------------------------------------------------
data BigRecord = BigRecord
{ field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
, field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
, field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
, field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
, field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
} deriving (Show, Eq, Generic, Data, Typeable)
instance NFData BigRecord
bigRecord = BigRecord 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
gBigRecordToJSON :: BigRecord -> Value
gBigRecordToJSON = genericToJSON opts
gBigRecordFromJSON :: Value -> Result BigRecord
gBigRecordFromJSON = parse $ genericParseJSON opts
thBigRecordToJSON :: BigRecord -> Value
thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
thBigRecordFromJSON :: Value -> Result BigRecord
thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
--------------------------------------------------------------------------------
data BigProduct = BigProduct
!Int !Int !Int !Int !Int
!Int !Int !Int !Int !Int
!Int !Int !Int !Int !Int
!Int !Int !Int !Int !Int
!Int !Int !Int !Int !Int
deriving (Show, Eq, Generic, Data, Typeable)
instance NFData BigProduct
bigProduct = BigProduct 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
gBigProductToJSON :: BigProduct -> Value
gBigProductToJSON = genericToJSON opts
gBigProductFromJSON :: Value -> Result BigProduct
gBigProductFromJSON = parse $ genericParseJSON opts
thBigProductToJSON :: BigProduct -> Value
thBigProductToJSON = $(mkToJSON opts ''BigProduct)
thBigProductFromJSON :: Value -> Result BigProduct
thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
--------------------------------------------------------------------------------
data BigSum = F01 | F02 | F03 | F04 | F05
| F06 | F07 | F08 | F09 | F10
| F11 | F12 | F13 | F14 | F15
| F16 | F17 | F18 | F19 | F20
| F21 | F22 | F23 | F24 | F25
deriving (Show, Eq, Generic, Data, Typeable)
instance NFData BigSum
bigSum = F25
gBigSumToJSON :: BigSum -> Value
gBigSumToJSON = genericToJSON opts
gBigSumFromJSON :: Value -> Result BigSum
gBigSumFromJSON = parse $ genericParseJSON opts
thBigSumToJSON :: BigSum -> Value
thBigSumToJSON = $(mkToJSON opts ''BigSum)
thBigSumFromJSON :: Value -> Result BigSum
thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
--------------------------------------------------------------------------------
type FJ a = Value -> Result a
main :: IO ()
main = defaultMain
[ let v = toJSON d
in (d, d', v) `deepseq`
bgroup "D"
[ group "toJSON" (nf toJSON d)
(nf G.toJSON d)
(nf toJSON d')
, group "fromJSON" (nf ( fromJSON :: FJ T ) v)
(nf (G.fromJSON :: FJ T ) v)
(nf ( fromJSON :: FJ T') v)
]
, let v = thBigRecordToJSON bigRecord
in bigRecord `deepseq` v `deepseq`
bgroup "BigRecord"
[ group "toJSON" (nf thBigRecordToJSON bigRecord)
(nf G.toJSON bigRecord)
(nf gBigRecordToJSON bigRecord)
, group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
(nf (G.fromJSON :: FJ BigRecord) v)
(nf (gBigRecordFromJSON :: FJ BigRecord) v)
]
, let v = thBigProductToJSON bigProduct
in bigProduct `deepseq` v `deepseq`
bgroup "BigProduct"
[ group "toJSON" (nf thBigProductToJSON bigProduct)
(nf G.toJSON bigProduct)
(nf gBigProductToJSON bigProduct)
, group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
(nf (G.fromJSON :: FJ BigProduct) v)
(nf (gBigProductFromJSON :: FJ BigProduct) v)
]
, let v = thBigSumToJSON bigSum
in bigSum `deepseq` v `deepseq`
bgroup "BigSum"
[ group "toJSON" (nf thBigSumToJSON bigSum)
(nf G.toJSON bigSum)
(nf gBigSumToJSON bigSum)
, group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
(nf (G.fromJSON :: FJ BigSum) v)
(nf (gBigSumFromJSON :: FJ BigSum) v)
]
]
group n th syb gen = bcompare
[ bgroup n [ bench "th" th
, bench "syb" syb
, bench "generic" gen
]
]