1
+ {-# LANGUAGE BangPatterns #-}
1
2
{-# LANGUAGE OverloadedStrings #-}
2
3
3
4
module Main where
4
5
5
6
import Control.Exception (throw )
6
7
import Control.Monad (forM )
7
- import Data.Map (Map , foldrWithKey , singleton , unions )
8
+ import Data.Map (Map )
9
+ import Data.Text (Text )
8
10
import Data.Void (Void )
9
- import Gauge (bench , bgroup , defaultMain , env , nf , whnf )
10
-
11
- import System.Directory
11
+ import Test.Tasty.Bench
12
12
13
13
import 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
16
17
import qualified Dhall.Binary
17
18
import qualified Dhall.Core as Dhall
18
19
import qualified Dhall.Parser as Dhall
19
- import qualified Gauge
20
+ import qualified System.Directory as Directory
20
21
21
- type PreludeFiles = Map FilePath T. Text
22
+ type PreludeFiles = Map FilePath Text
22
23
23
24
loadPreludeFiles :: IO PreludeFiles
24
25
loadPreludeFiles = loadDirectory " ./dhall-lang/Prelude"
25
26
where
26
27
loadDirectory :: FilePath -> IO PreludeFiles
27
28
loadDirectory dir =
28
- withCurrentDirectory dir $ do
29
- files <- getCurrentDirectory >>= listDirectory
29
+ Directory. withCurrentDirectory dir $ do
30
+ files <- Directory. getCurrentDirectory >>= Directory. listDirectory
30
31
results <- forM files $ \ file -> do
31
- file' <- makeAbsolute file
32
- doesExist <- doesFileExist file'
32
+ file' <- Directory. makeAbsolute file
33
+ doesExist <- Directory. doesFileExist file'
33
34
if doesExist
34
35
then loadFile file'
35
36
else loadDirectory file'
36
- pure $ unions results
37
+ pure $ Map. unions results
37
38
38
39
loadFile :: FilePath -> IO PreludeFiles
39
- loadFile path = singleton path <$> TIO .readFile path
40
+ loadFile path = Map. singleton path <$> Data.Text.IO .readFile path
40
41
41
- benchParser :: PreludeFiles -> Gauge. Benchmark
42
+ benchParser :: PreludeFiles -> Benchmark
42
43
benchParser =
43
44
bgroup " exprFromText"
44
- . foldrWithKey (\ name expr -> (benchExprFromText name expr : )) []
45
+ . Map. foldrWithKey (\ name expr -> (benchExprFromText name expr : )) []
45
46
46
- benchExprFromText :: String -> T. Text -> Gauge. Benchmark
47
- benchExprFromText name expr =
47
+ benchExprFromText :: String -> Text -> Benchmark
48
+ benchExprFromText name ! expr =
48
49
bench name $ whnf (Dhall. exprFromText " (input)" ) expr
49
50
50
- benchExprFromBytes
51
- :: String -> Data.ByteString.Lazy. ByteString -> Gauge. Benchmark
51
+ benchExprFromBytes :: String -> Data.ByteString.Lazy. ByteString -> Benchmark
52
52
benchExprFromBytes name bs = bench name (nf f bs)
53
53
where
54
54
f bytes =
55
55
case Dhall.Binary. decodeExpression bytes of
56
56
Left exception -> error (show exception)
57
57
Right expression -> expression :: Dhall. Expr Void Dhall. Import
58
58
59
- benchNfExprFromText :: String -> T. Text -> Gauge. Benchmark
60
- benchNfExprFromText name expr =
59
+ benchNfExprFromText :: String -> Text -> Benchmark
60
+ benchNfExprFromText name ! expr =
61
61
bench name $ nf (either throw id . Dhall. exprFromText " (input)" ) expr
62
62
63
63
main :: IO ()
@@ -71,20 +71,21 @@ main = do
71
71
]
72
72
, env kubernetesExample $
73
73
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 " " <> " -}" )
81
81
, benchExprFromText " Deeply nested parentheses" " ((((((((((((((((x))))))))))))))))"
82
82
, benchParser prelude
83
83
, env cpkgExample $
84
84
benchNfExprFromText " CPkg/Text"
85
85
]
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