SchemaQQ.hs

{-# LANGUAGE TemplateHaskell #-}

module Benchmarks.SchemaQQ where

import Criterion.Main
import Language.Haskell.TH.Quote (QuasiQuoter (quoteType))
import Language.Haskell.TH.TestUtils (
  QMode (..),
  QState (..),
  loadNames,
  runTestQ,
 )

import qualified Data.Aeson.Schema

import Benchmarks.Data.Schemas
import Utils.DeepSeq ()

benchmarks :: Benchmark
benchmarks =
  bgroup
    "schema quasiquoter"
    [ byKeys
    , byNestedKeys
    , byNumOfIncluded
    , byKeysInIncluded
    , byNumOfExtended
    , byKeysInExtended
    ]
  where
    byKeys = bgroup "# of keys" $
      flip map [1, 5, 10, 100] $ \n ->
        let schemaDef = genSchemaDef $ keysTo n
         in bench (show n) $ nf runSchema schemaDef

    byNestedKeys = bgroup "# of nested keys" $
      flip map [1, 5, 10, 100] $ \n ->
        let schemaDef = iterateN n (\prev -> genSchemaDef [Field "a" prev]) "Int"
         in bench (show n) $ nf runSchema schemaDef

    byNumOfIncluded = bgroup "Include given # of schemas" $
      flip map [1, 5, 10, 100] $ \n ->
        let schemaDef = genSchemaDef $ map (\name -> Include name name) $ take n singleSchemas
         in bench (show n) $ nf runSchema schemaDef

    byKeysInIncluded = bgroup "Include schema with given # of keys" $
      flip map sizedSchemas $ \(n, schema) ->
        let schemaDef = genSchemaDef [Include "a" schema]
         in bench (show n) $ nf runSchema schemaDef

    byNumOfExtended = bgroup "Extend given # of schemas" $
      flip map [1, 5, 10, 100] $ \n ->
        let schemaDef = genSchemaDef $ map Ref $ take n singleSchemas
         in bench (show n) $ nf runSchema schemaDef

    byKeysInExtended = bgroup "Extend schema with given # of keys" $
      flip map sizedSchemas $ \(n, schema) ->
        let schemaDef = genSchemaDef [Field "a" "Int", Ref schema]
         in bench (show n) $ nf runSchema schemaDef

    runSchema =
      let qstate =
            QState
              { mode = MockQ
              , knownNames = sizedSchemasNames ++ singleSchemasNames
              , reifyInfo = $(loadNames $ map snd $ sizedSchemasNames ++ singleSchemasNames)
              }
       in runTestQ qstate . quoteType Data.Aeson.Schema.schema

{- Utilities -}

{- | Apply the given functions the given number of times.

 The first parameter must be >= 0.
-}
iterateN :: Int -> (a -> a) -> a -> a
iterateN n f x = iterate f x !! n