Source

aeson / benchmarks / AesonCompareAutoInstances.hs

Full commit
{-# 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
                                ]
                     ]