{-# LANGUAGE DeriveGeneric #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE TemplateHaskell #-}

module Main (main) where

import Prelude ()

import Prelude.Compat

import Control.Monad

import Control.DeepSeq (NFData, rnf, deepseq)

import Criterion.Main hiding (defaultOptions)

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

toBS :: Encoding -> ByteString

toBS = encodingToLazyByteString

gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString

gEncode = toBS . genericToEncoding opts

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

data D a = Nullary

         | Unary Int

         | Product String Char a

         | Record { testOne   :: Double

                  , testTwo   :: Bool

                  , testThree :: D a

                  }

           deriving (Show, Eq)

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)

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)

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

return []

gBigRecordToJSON :: BigRecord -> Value

gBigRecordToJSON = genericToJSON opts

gBigRecordEncode :: BigRecord -> ByteString

gBigRecordEncode = gEncode

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)

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

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)

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

return []

gBigProductToJSON :: BigProduct -> Value

gBigProductToJSON = genericToJSON opts

gBigProductEncode :: BigProduct -> ByteString

gBigProductEncode = gEncode

gBigProductFromJSON :: Value -> Result BigProduct

gBigProductFromJSON = parse $ genericParseJSON opts

thBigProductToJSON :: BigProduct -> Value

thBigProductToJSON = $(mkToJSON opts ''BigProduct)

thBigProductEncode :: BigProduct -> ByteString

thBigProductEncode = toBS . $(mkToEncoding 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)

instance NFData BigSum

bigSum = F25

return []

gBigSumToJSON :: BigSum -> Value

gBigSumToJSON = genericToJSON opts

gBigSumEncode :: BigSum -> ByteString

gBigSumEncode = gEncode

gBigSumFromJSON :: Value -> Result BigSum

gBigSumFromJSON = parse $ genericParseJSON opts

thBigSumToJSON :: BigSum -> Value

thBigSumToJSON = $(mkToJSON opts ''BigSum)

thBigSumEncode :: BigSum -> ByteString

thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)

thBigSumFromJSON :: Value -> Result BigSum

thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)

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

type FJ a = Value -> Result a

runBench :: IO ()

runBench = defaultMain

  [ let v = toJSON d

    in (d, d', v) `deepseq`

       bgroup "D"

       [ group "toJSON"   (nf   toJSON d)

                          (nf   toJSON d')

       , group "encode"   (nf encode d)

                          (nf encode d')

       , group "fromJSON" (nf (  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  gBigRecordToJSON bigRecord)

       , group "encode"   (nf thBigRecordEncode bigRecord)

                          (nf  gBigRecordEncode bigRecord)

       , group "fromJSON" (nf (thBigRecordFromJSON :: 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 gBigProductToJSON  bigProduct)

       , group "encode"   (nf thBigProductEncode bigProduct)

                          (nf  gBigProductEncode bigProduct)

       , group "fromJSON" (nf (thBigProductFromJSON :: 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 gBigSumToJSON  bigSum)

       , group "encode"   (nf thBigSumEncode bigSum)

                          (nf  gBigSumEncode bigSum)

       , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)

                          (nf (gBigSumFromJSON  :: FJ BigSum) v)

       ]

  ]

group n th gen = bgroup n [ bench "th"      th

                          , bench "generic" gen

                          ]

sanityCheck = do

  check d toJSON fromJSON encode

  check d' toJSON fromJSON encode

  check bigRecord thBigRecordToJSON thBigRecordFromJSON thBigRecordEncode

  check bigRecord gBigRecordToJSON gBigRecordFromJSON gBigRecordEncode

  check bigProduct thBigProductToJSON thBigProductFromJSON thBigProductEncode

  check bigProduct gBigProductToJSON gBigProductFromJSON gBigProductEncode

  check bigSum thBigSumToJSON thBigSumFromJSON thBigSumEncode

  check bigSum gBigSumToJSON gBigSumFromJSON gBigSumEncode

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