Source

aeson / benchmarks / AesonCompareAutoInstances.hs

{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}

module Main where

--------------------------------------------------------------------------------

import Criterion.Main

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 (mkToJSON, mkParseJSON)
import qualified Data.Aeson.Generic as G (fromJSON, toJSON)

--------------------------------------------------------------------------------

-- Taken from the documentation of Data.Aeson.TH:
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 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
                    }
    }

instance ToJSON   a => ToJSON   (D a)
instance FromJSON a => FromJSON (D a)

thDToJSON :: ToJSON a => D a -> Value
thDToJSON = $(mkToJSON id ''D)

thDParseJSON :: FromJSON a => Value -> Parser (D a)
thDParseJSON = $(mkParseJSON id ''D)

thDFromJSON :: FromJSON a => Value -> Result (D a)
thDFromJSON = parse thDParseJSON

--------------------------------------------------------------------------------

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

instance ToJSON   BigRecord
instance FromJSON BigRecord

thBigRecordToJSON :: BigRecord -> Value
thBigRecordToJSON = $(mkToJSON id ''BigRecord)

thBigRecordParseJSON :: Value -> Parser BigRecord
thBigRecordParseJSON = $(mkParseJSON id ''BigRecord)

thBigRecordFromJSON :: Value -> Result BigRecord
thBigRecordFromJSON = parse thBigRecordParseJSON

--------------------------------------------------------------------------------

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

instance ToJSON   BigProduct
instance FromJSON BigProduct

thBigProductToJSON :: BigProduct -> Value
thBigProductToJSON = $(mkToJSON id ''BigProduct)

thBigProductParseJSON :: Value -> Parser BigProduct
thBigProductParseJSON = $(mkParseJSON id ''BigProduct)

thBigProductFromJSON :: Value -> Result BigProduct
thBigProductFromJSON = parse thBigProductParseJSON

--------------------------------------------------------------------------------

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

instance ToJSON   BigSum
instance FromJSON BigSum

thBigSumToJSON :: BigSum -> Value
thBigSumToJSON = $(mkToJSON id ''BigSum)

thBigSumParseJSON :: Value -> Parser BigSum
thBigSumParseJSON = $(mkParseJSON id ''BigSum)

thBigSumFromJSON :: Value -> Result BigSum
thBigSumFromJSON = parse thBigSumParseJSON

--------------------------------------------------------------------------------

type FJ a = Value -> Result a

main :: IO ()
main = defaultMain
  [ let v = thDToJSON d
    in d `deepseq` v `deepseq`
       bgroup "D"
       [ group "toJSON"   (nf thDToJSON d)
                          (nf G.toJSON  d)
                          (nf toJSON    d)
       , group "fromJSON" (nf (thDFromJSON :: 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 toJSON            bigRecord)
       , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
                          (nf (G.fromJSON          :: FJ BigRecord) v)
                          (nf (fromJSON            :: FJ BigRecord) v)
       ]
  , let v = thBigProductToJSON bigProduct
    in bigProduct `deepseq` v `deepseq`
       bgroup "BigProduct"
       [ group "toJSON"   (nf thBigProductToJSON bigProduct)
                          (nf G.toJSON           bigProduct)
                          (nf toJSON             bigProduct)
       , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
                          (nf (G.fromJSON           :: FJ BigProduct) v)
                          (nf (fromJSON             :: FJ BigProduct) v)
       ]
  , let v = thBigSumToJSON bigSum
    in bigSum `deepseq` v `deepseq`
       bgroup "BigSum"
       [ group "toJSON"   (nf thBigSumToJSON bigSum)
                          (nf G.toJSON       bigSum)
                          (nf toJSON         bigSum)
       , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
                          (nf (G.fromJSON       :: FJ BigSum) v)
                          (nf (fromJSON         :: FJ BigSum) v)
       ]
  ]

group n th syb gen = bgroup n [ bench "th"      th
                              , bench "syb"     syb
                              , bench "generic" gen
                              ]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.