Create a gist now

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Main (main) where
import Prelude ()
import Prelude.Compat
import Control.Monad
import Control.DeepSeq (NFData, rnf, deepseq)
#ifndef DONTRUN
import Criterion.Main hiding (defaultOptions)
#endif
import Data.Aeson
import Data.Aeson.Encoding
import Data.Aeson.TH
import Data.Aeson.Types
import Data.ByteString.Lazy (ByteString)
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic, Rep)
import Options
import GHC.Exts
toBS :: Encoding -> ByteString
toBS = encodingToLazyByteString
gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString
gEncode = toBS . inline genericToEncoding opts
data BigRecord = BigRecord
{ field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
} deriving (Show, Eq, Generic)
instance NFData BigRecord
bigRecord = BigRecord 1 2 3 4 5
return []
gBigRecordToJSON :: BigRecord -> Value
gBigRecordToJSON = genericToJSON opts
gBigRecordEncode :: BigRecord -> ByteString
gBigRecordEncode = gEncode
#ifdef DONTRUN
{-# NOINLINE gBigRecordEncode #-}
{-# NOINLINE thBigRecordEncode #-}
#endif
gBigRecordFromJSON :: Value -> Result BigRecord
gBigRecordFromJSON = parse $ genericParseJSON opts
thBigRecordToJSON :: BigRecord -> Value
thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
thBigRecordEncode :: BigRecord -> ByteString
thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
thBigRecordFromJSON :: Value -> Result BigRecord
thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
--------------------------------------------------------------------------------
type FJ a = Value -> Result a
runBench :: IO ()
#ifndef DONTRUN
runBench = defaultMain
[ let v = thBigRecordToJSON bigRecord
in bigRecord `deepseq` v `deepseq`
bgroup "BigRecord"
[ group "toJSON" (nf thBigRecordToJSON bigRecord)
(nf gBigRecordToJSON bigRecord)
, group "encode" (nf thBigRecordEncode bigRecord)
(nf gBigRecordEncode bigRecord)
, group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
(nf ( gBigRecordFromJSON :: FJ BigRecord) v)
]
]
group n th gen = bgroup n [ bench "th" th
, bench "generic" gen
]
#else
runBench = return ()
#endif
sanityCheck = do
check bigRecord thBigRecordToJSON thBigRecordFromJSON thBigRecordEncode
check bigRecord gBigRecordToJSON gBigRecordFromJSON gBigRecordEncode
check :: (Show a, Eq a)
=> a -> (a -> Value) -> (Value -> Result a) -> (a -> ByteString) -> IO ()
check x toJSON fromJSON encode = do
unless (Success x == (fromJSON . toJSON) x) $ fail $ "toJSON: " ++ show x
unless (Success x == (decode' . encode) x) $ fail $ "encode: " ++ show x
where
decode' s = case decode s of
Just v -> fromJSON v
Nothing -> fail ""
main = do
sanityCheck
runBench
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment