Benchmarks: Switch from gauge to tasty-bench

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

@@ -1,14 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
-import Data.Void (Void)
-import Gauge     (defaultMain)
+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
-import qualified Gauge
 
 dhallPreludeImport :: Core.Import
 dhallPreludeImport = Core.Import
@@ -22,8 +21,8 @@ dhallPreludeImport = Core.Import
     }
   }
 
-issue412 :: Core.Expr s Void -> Gauge.Benchmarkable
-issue412 prelude = Gauge.whnf TypeCheck.typeOf expr
+issue412 :: Core.Expr s Void -> Benchmarkable
+issue412 prelude = whnf TypeCheck.typeOf expr
   where
     expr
       = Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)
@@ -34,8 +33,8 @@ issue412 prelude = Gauge.whnf TypeCheck.typeOf expr
     little = Core.makeFieldSelection "little"
     foo = Core.makeFieldSelection "Foo"
 
-unionPerformance :: Core.Expr s Void -> Gauge.Benchmarkable
-unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr
+unionPerformance :: Core.Expr s Void -> Benchmarkable
+unionPerformance prelude = whnf TypeCheck.typeOf expr
   where
     expr =
         Core.Let
@@ -64,10 +63,10 @@ unionPerformance prelude = Gauge.whnf TypeCheck.typeOf expr
 main :: IO ()
 main =
   defaultMain
-    [ Gauge.env prelude $ \p ->
-      Gauge.bgroup "Prelude"
-        [ Gauge.bench "issue 412" (issue412 p)
-        , Gauge.bench "union performance" (unionPerformance p)
+    [ env prelude $ \p ->
+      bgroup "Prelude"
+        [ bench "issue 412" (issue412 p)
+        , bench "union performance" (unionPerformance p)
         ]
     ]
   where prelude = Import.load (Core.Embed dhallPreludeImport)

dhall/benchmark/parser/Main.hs

@@ -1,63 +1,63 @@
+{-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
 import Control.Exception (throw)
 import Control.Monad     (forM)
-import Data.Map          (Map, foldrWithKey, singleton, unions)
+import Data.Map          (Map)
+import Data.Text         (Text)
 import Data.Void         (Void)
-import Gauge             (bench, bgroup, defaultMain, env, nf, whnf)
-
-import System.Directory
+import Test.Tasty.Bench
 
 import qualified Data.ByteString.Lazy
-import qualified Data.Text            as T
-import qualified Data.Text.IO         as TIO
+import qualified Data.Map             as Map
+import qualified Data.Text            as Text
+import qualified Data.Text.IO
 import qualified Dhall.Binary
 import qualified Dhall.Core           as Dhall
 import qualified Dhall.Parser         as Dhall
-import qualified Gauge
+import qualified System.Directory     as Directory
 
-type PreludeFiles = Map FilePath T.Text
+type PreludeFiles = Map FilePath Text
 
 loadPreludeFiles :: IO PreludeFiles
 loadPreludeFiles = loadDirectory "./dhall-lang/Prelude"
     where
         loadDirectory :: FilePath -> IO PreludeFiles
         loadDirectory dir =
-            withCurrentDirectory dir $ do
-                files <- getCurrentDirectory >>= listDirectory
+            Directory.withCurrentDirectory dir $ do
+                files <- Directory.getCurrentDirectory >>= Directory.listDirectory
                 results <- forM files $ \file -> do
-                    file' <- makeAbsolute file
-                    doesExist <- doesFileExist file'
+                    file' <- Directory.makeAbsolute file
+                    doesExist <- Directory.doesFileExist file'
                     if doesExist
                        then loadFile file'
                        else loadDirectory file'
-                pure $ unions results
+                pure $ Map.unions results
 
         loadFile :: FilePath -> IO PreludeFiles
-        loadFile path = singleton path <$> TIO.readFile path
+        loadFile path = Map.singleton path <$> Data.Text.IO.readFile path
 
-benchParser :: PreludeFiles -> Gauge.Benchmark
+benchParser :: PreludeFiles -> Benchmark
 benchParser =
       bgroup "exprFromText"
-    . foldrWithKey (\name expr -> (benchExprFromText name expr :)) []
+    . Map.foldrWithKey (\name expr -> (benchExprFromText name expr :)) []
 
-benchExprFromText :: String -> T.Text -> Gauge.Benchmark
-benchExprFromText name expr =
+benchExprFromText :: String -> Text -> Benchmark
+benchExprFromText name !expr =
     bench name $ whnf (Dhall.exprFromText "(input)") expr
 
-benchExprFromBytes
-    :: String -> Data.ByteString.Lazy.ByteString -> Gauge.Benchmark
+benchExprFromBytes :: String -> Data.ByteString.Lazy.ByteString -> Benchmark
 benchExprFromBytes name bs = bench name (nf f bs)
   where
     f bytes =
         case Dhall.Binary.decodeExpression bytes of
             Left  exception  -> error (show exception)
             Right expression -> expression :: Dhall.Expr Void Dhall.Import
 
-benchNfExprFromText :: String -> T.Text -> Gauge.Benchmark
-benchNfExprFromText name expr =
+benchNfExprFromText :: String -> Text -> Benchmark
+benchNfExprFromText name !expr =
     bench name $ nf (either throw id . Dhall.exprFromText "(input)") expr
 
 main :: IO ()
@@ -71,20 +71,21 @@ main = do
                 ]
         , env kubernetesExample $
             benchExprFromBytes "Kubernetes/Binary"
-        , benchExprFromText "Long variable names" (T.replicate 1000000 "x")
-        , benchExprFromText "Large number of function arguments" (T.replicate 10000 "x ")
-        , benchExprFromText "Long double-quoted strings" ("\"" <> T.replicate 1000000 "x" <> "\"")
-        , benchExprFromText "Long single-quoted strings" ("''" <> T.replicate 1000000 "x" <> "''")
-        , benchExprFromText "Whitespace" (T.replicate 1000000 " " <> "x")
-        , benchExprFromText "Line comment" ("x -- " <> T.replicate 1000000 " ")
-        , benchExprFromText "Block comment" ("x {- " <> T.replicate 1000000 " " <> "-}")
+        , benchExprFromText "Long variable names" (Text.replicate 1000000 "x")
+        , benchExprFromText "Large number of function arguments" (Text.replicate 10000 "x ")
+        , benchExprFromText "Long double-quoted strings" ("\"" <> Text.replicate 1000000 "x" <> "\"")
+        , benchExprFromText "Long single-quoted strings" ("''" <> Text.replicate 1000000 "x" <> "''")
+        , benchExprFromText "Whitespace" (Text.replicate 1000000 " " <> "x")
+        , benchExprFromText "Line comment" ("x -- " <> Text.replicate 1000000 " ")
+        , benchExprFromText "Block comment" ("x {- " <> Text.replicate 1000000 " " <> "-}")
         , benchExprFromText "Deeply nested parentheses" "((((((((((((((((x))))))))))))))))"
         , benchParser prelude
         , env cpkgExample $
             benchNfExprFromText "CPkg/Text"
         ]
-    where cpkgExample = TIO.readFile "benchmark/examples/cpkg.dhall"
-          issue108Text = TIO.readFile "benchmark/examples/issue108.dhall"
-          issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/examples/issue108.dhall.bin"
-          issues = (,) <$> issue108Text <*> issue108Bytes
-          kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/examples/kubernetes.dhall.bin"
+    where
+        cpkgExample = Data.Text.IO.readFile "benchmark/parser/examples/cpkg.dhall"
+        issue108Text = Data.Text.IO.readFile "benchmark/parser/examples/issue108.dhall"
+        issue108Bytes = Data.ByteString.Lazy.readFile "benchmark/parser/examples/issue108.dhallb"
+        issues = (,) <$> issue108Text <*> issue108Bytes
+        kubernetesExample = Data.ByteString.Lazy.readFile "benchmark/parser/examples/kubernetes.dhallb"

dhall/dhall.cabal

@@ -26,6 +26,7 @@ Data-Files:
 Extra-Source-Files:
     CHANGELOG.md
     benchmark/**/*.dhall
+    benchmark/**/*.dhallb
     dhall-lang/Prelude/**/*.dhall
     dhall-lang/Prelude/Bool/and
     dhall-lang/Prelude/Bool/build
@@ -475,7 +476,7 @@ Benchmark dhall-parser
     Main-Is: Main.hs
     Build-Depends:
         dhall                                         ,
-        gauge                     >= 0.2.3    && < 0.3,
+        tasty-bench               >= 0.4      && < 0.5,
     Default-Language: Haskell2010
     Other-Extensions:
         TypeApplications
@@ -488,5 +489,5 @@ Benchmark deep-nested-large-record
     Main-Is: Main.hs
     Build-Depends:
         dhall                                         ,
-        gauge                     >= 0.2.3    && < 0.3
+        tasty-bench               >= 0.4      && < 0.5,
     Default-Language: Haskell2010

nix/packages/tasty-bench.nix

@@ -0,0 +1,11 @@
+{ mkDerivation, base, containers, deepseq, ghc-prim, lib, tasty }:
+mkDerivation {
+  pname = "tasty-bench";
+  version = "0.4";
+  sha256 = "829c80478dcd6450f3ddab0232603850bff6bc7277b2eecf126b2fd9c26d7be2";
+  libraryHaskellDepends = [ base containers deepseq ghc-prim tasty ];
+  benchmarkHaskellDepends = [ base ];
+  homepage = "https://github.com/Bodigrim/tasty-bench";
+  description = "Featherlight benchmark framework";
+  license = lib.licenses.mit;
+}

nix/shared.nix

@@ -230,15 +230,6 @@ let
                             '';
                           }
                         );
-
-                    gauge =
-                      pkgsNew.haskell.lib.appendPatch
-                        haskellPackagesOld.gauge
-                        (pkgsNew.fetchpatch {
-                          url = "https://github.com/vincenthz/hs-gauge/commit/303a6b611804c85b9a6bc1cea5de4e6ce3429d24.patch";
-
-                          sha256 = "sha256-4osUMo0cvTvyDTXF8lY9tQbFqLywRwsc3RkHIhqSriQ=";
-                        });
                   };
 
               in