dhall-1.42.3: benchmark/deep-nested-large-record/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import Data.Void        (Void)
import Test.Tasty.Bench

import qualified Data.Sequence   as Seq
import qualified Dhall.Core      as Core
import qualified Dhall.Import    as Import
import qualified Dhall.TypeCheck as TypeCheck

dhallPreludeImport :: Core.Import
dhallPreludeImport = Core.Import
  { Core.importMode = Core.Code
  , Core.importHashed = Core.ImportHashed
    { Core.hash = Nothing
    , Core.importType = Core.Local Core.Here $ Core.File
      { Core.directory = Core.Directory ["deep-nested-large-record", "benchmark"]
      , Core.file = "prelude.dhall"
      }
    }
  }

issue412 :: Core.Expr s Void -> Benchmarkable
issue412 prelude = whnf TypeCheck.typeOf expr
  where
    expr
      = Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)
      $ Core.ListLit Nothing
      $ Seq.replicate 5
      $ Core.Var (Core.V "prelude" 0) `Core.Field` types `Core.Field` little `Core.Field` foo
    types = Core.makeFieldSelection "types"
    little = Core.makeFieldSelection "little"
    foo = Core.makeFieldSelection "Foo"

unionPerformance :: Core.Expr s Void -> Benchmarkable
unionPerformance prelude = whnf TypeCheck.typeOf expr
  where
    expr =
        Core.Let
            (Core.Binding
                Nothing
                "x"
                Nothing
                Nothing
                Nothing
                (Core.Let
                    (Core.Binding
                        Nothing
                        "big"
                        Nothing
                        Nothing
                        Nothing
                        (prelude `Core.Field` types `Core.Field` big)
                    )
                    (Core.Prefer mempty Core.PreferFromSource "big" "big")
                )
            )
            "x"
    types = Core.makeFieldSelection "types"
    big = Core.makeFieldSelection "Big"

main :: IO ()
main =
  defaultMain
    [ env prelude $ \p ->
      bgroup "Prelude"
        [ bench "issue 412" (issue412 p)
        , bench "union performance" (unionPerformance p)
        ]
    ]
  where prelude = Import.load (Core.Embed dhallPreludeImport)