1+ {-# LANGUAGE BangPatterns #-}
12{-# LANGUAGE OverloadedStrings #-}
23
34module Main where
45
56import Control.Exception (throw )
67import Control.Monad (forM )
7- import Data.Map (Map , foldrWithKey , singleton , unions )
8+ import Data.Map (Map )
9+ import Data.Text (Text )
810import Data.Void (Void )
9- import Gauge (bench , bgroup , defaultMain , env , nf , whnf )
10-
11- import System.Directory
11+ import Test.Tasty.Bench
1212
1313import qualified Data.ByteString.Lazy
14- import qualified Data.Text as T
15- import qualified Data.Text.IO as TIO
14+ import qualified Data.Map as Map
15+ import qualified Data.Text as Text
16+ import qualified Data.Text.IO
1617import qualified Dhall.Binary
1718import qualified Dhall.Core as Dhall
1819import qualified Dhall.Parser as Dhall
19- import qualified Gauge
20+ import qualified System.Directory as Directory
2021
21- type PreludeFiles = Map FilePath T. Text
22+ type PreludeFiles = Map FilePath Text
2223
2324loadPreludeFiles :: IO PreludeFiles
2425loadPreludeFiles = loadDirectory " ./dhall-lang/Prelude"
2526 where
2627 loadDirectory :: FilePath -> IO PreludeFiles
2728 loadDirectory dir =
28- withCurrentDirectory dir $ do
29- files <- getCurrentDirectory >>= listDirectory
29+ Directory. withCurrentDirectory dir $ do
30+ files <- Directory. getCurrentDirectory >>= Directory. listDirectory
3031 results <- forM files $ \ file -> do
31- file' <- makeAbsolute file
32- doesExist <- doesFileExist file'
32+ file' <- Directory. makeAbsolute file
33+ doesExist <- Directory. doesFileExist file'
3334 if doesExist
3435 then loadFile file'
3536 else loadDirectory file'
36- pure $ unions results
37+ pure $ Map. unions results
3738
3839 loadFile :: FilePath -> IO PreludeFiles
39- loadFile path = singleton path <$> TIO .readFile path
40+ loadFile path = Map. singleton path <$> Data.Text.IO .readFile path
4041
41- benchParser :: PreludeFiles -> Gauge. Benchmark
42+ benchParser :: PreludeFiles -> Benchmark
4243benchParser =
4344 bgroup " exprFromText"
44- . foldrWithKey (\ name expr -> (benchExprFromText name expr : )) []
45+ . Map. foldrWithKey (\ name expr -> (benchExprFromText name expr : )) []
4546
46- benchExprFromText :: String -> T. Text -> Gauge. Benchmark
47- benchExprFromText name expr =
47+ benchExprFromText :: String -> Text -> Benchmark
48+ benchExprFromText name ! expr =
4849 bench name $ whnf (Dhall. exprFromText " (input)" ) expr
4950
50- benchExprFromBytes
51- :: String -> Data.ByteString.Lazy. ByteString -> Gauge. Benchmark
51+ benchExprFromBytes :: String -> Data.ByteString.Lazy. ByteString -> Benchmark
5252benchExprFromBytes name bs = bench name (nf f bs)
5353 where
5454 f bytes =
5555 case Dhall.Binary. decodeExpression bytes of
5656 Left exception -> error (show exception)
5757 Right expression -> expression :: Dhall. Expr Void Dhall. Import
5858
59- benchNfExprFromText :: String -> T. Text -> Gauge. Benchmark
60- benchNfExprFromText name expr =
59+ benchNfExprFromText :: String -> Text -> Benchmark
60+ benchNfExprFromText name ! expr =
6161 bench name $ nf (either throw id . Dhall. exprFromText " (input)" ) expr
6262
6363main :: IO ()
@@ -71,20 +71,21 @@ main = do
7171 ]
7272 , env kubernetesExample $
7373 benchExprFromBytes " Kubernetes/Binary"
74- , benchExprFromText " Long variable names" (T .replicate 1000000 " x" )
75- , benchExprFromText " Large number of function arguments" (T .replicate 10000 " x " )
76- , benchExprFromText " Long double-quoted strings" (" \" " <> T .replicate 1000000 " x" <> " \" " )
77- , benchExprFromText " Long single-quoted strings" (" ''" <> T .replicate 1000000 " x" <> " ''" )
78- , benchExprFromText " Whitespace" (T .replicate 1000000 " " <> " x" )
79- , benchExprFromText " Line comment" (" x -- " <> T .replicate 1000000 " " )
80- , benchExprFromText " Block comment" (" x {- " <> T .replicate 1000000 " " <> " -}" )
74+ , benchExprFromText " Long variable names" (Text .replicate 1000000 " x" )
75+ , benchExprFromText " Large number of function arguments" (Text .replicate 10000 " x " )
76+ , benchExprFromText " Long double-quoted strings" (" \" " <> Text .replicate 1000000 " x" <> " \" " )
77+ , benchExprFromText " Long single-quoted strings" (" ''" <> Text .replicate 1000000 " x" <> " ''" )
78+ , benchExprFromText " Whitespace" (Text .replicate 1000000 " " <> " x" )
79+ , benchExprFromText " Line comment" (" x -- " <> Text .replicate 1000000 " " )
80+ , benchExprFromText " Block comment" (" x {- " <> Text .replicate 1000000 " " <> " -}" )
8181 , benchExprFromText " Deeply nested parentheses" " ((((((((((((((((x))))))))))))))))"
8282 , benchParser prelude
8383 , env cpkgExample $
8484 benchNfExprFromText " CPkg/Text"
8585 ]
86- where cpkgExample = TIO. readFile " benchmark/examples/cpkg.dhall"
87- issue108Text = TIO. readFile " benchmark/examples/issue108.dhall"
88- issue108Bytes = Data.ByteString.Lazy. readFile " benchmark/examples/issue108.dhall.bin"
89- issues = (,) <$> issue108Text <*> issue108Bytes
90- kubernetesExample = Data.ByteString.Lazy. readFile " benchmark/examples/kubernetes.dhall.bin"
86+ where
87+ cpkgExample = Data.Text.IO. readFile " benchmark/parser/examples/cpkg.dhall"
88+ issue108Text = Data.Text.IO. readFile " benchmark/parser/examples/issue108.dhall"
89+ issue108Bytes = Data.ByteString.Lazy. readFile " benchmark/parser/examples/issue108.dhallb"
90+ issues = (,) <$> issue108Text <*> issue108Bytes
91+ kubernetesExample = Data.ByteString.Lazy. readFile " benchmark/parser/examples/kubernetes.dhallb"
0 commit comments