{-# 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