Main.hs

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

import Data.Void (Void)
import Gauge     (defaultMain)

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

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 -> Gauge.Benchmarkable
issue412 prelude = Gauge.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 -> Gauge.Benchmarkable
unionPerformance prelude = Gauge.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
    [ Gauge.env prelude $ \p ->
      Gauge.bgroup "Prelude"
        [ Gauge.bench "issue 412" (issue412 p)
        , Gauge.bench "union performance" (unionPerformance p)
        ]
    ]
  where prelude = Import.load (Core.Embed dhallPreludeImport)