@@ -1,212 +1,100 @@
11module Benchmark
2− ( Never
3− , Benchmark
4− , Suite (..)
5− , BenchStats
6− , run
7− , runWithProgress
2+ ( Suite
83 , bench
9− , bench1
10− , bench2
11− , bench3
12− , bench4
13− , bench5
14− , bench6
15− , bench7
16− , bench8
17− , bench9
4+ , suite
5+ , run
6+ , Statistics
7+ , statisticsToString
188 )where
19−{-| A wrapper around benchmark.js that allows benchmarking
20−of pure functions to be evaluated.
21−
22−# Error and Benchmark types
23−@docs Never, Benchmark, Suite, BenchStats
9+{-| A wrapper around benchmark.js that allows benchmarking of pure functions.
2410
25−# Running benchmarks
26−@docs run, runWithProgress
11+# Creating Benchmarks
12+@docs Benchmark, bench, suite
2713
28−# Creating benchmarks
29−@docs bench, bench1, bench2, bench3, bench4, bench5, bench6, bench7, bench8, bench9
14+# Run benchmarks
15+@docs run, Statistics
3016-}
3117
3218
33−import Task
34−import String
3519import Native.Benchmark
3620import Native.BenchmarkJS
37−import Signal
38−import Time
39−
40−
41−{-|
42−Our error return type: can never be instantiated
43−because running benchmarks should not fail
44−|-}
45−type Never =
46− Never Never
47−
48−
49−{-|
50−Opaque type representing a function to be timed
51−|-}
52−type Benchmark =
53− Benchmark
54−
55−
56−{-|
57−The results of running a benchmark
58−|-}
59−type BenchStats =
60− BenchStats
61− { name : String
62− , hz : Float
63− , marginOfError : Float
64− , moePercent : Float
65−-- , numRunsSampled : Int
66− }
67−
68−
69−{-|
70−A single or collection of benchmarks
71−that can be run, generating output
72−|-}
73−type Suite =
74− SingleBenchmark Benchmark
21+import String
22+import Task
23+
24+
25+
26+-- SET UP BENCHMARK SUITE
27+
28+
29+{-| A set of benchmarks. -}
30+type Benchmark
31+ = Test String Thunk
7532 | Suite String (List Benchmark)
7633
7734
78−{-|
79−Run a benchmark, generating a list of results for each benchmark.
80−Results contain a pretty-printed string summary, and a list
81−of detailed data for each benchmark.
82−|-}
83−run
84− : Suite
85− -> Task.Task Never (String, List BenchStats)
86−run = runWithProgress Nothing
87−
88−
89−{-|
90−Run a benchmark, generating a list of results for each benchmark
91−and updating a String signal with progress as the benchmarks run
92−|-}
93−runWithProgress
94− : Maybe (Signal.Mailbox String)
95− -> Suite
96− -> Task.Task Never (String, List BenchStats)
97−runWithProgress maybeMailbox suite =
98− let
99− ourTask =
100− case maybeMailbox of
101− Nothing -> \_ -> Task.sleep 0
102− Just mailbox ->
103− \s ->
104− (Signal.send mailbox.address s
105− `Task.andThen` \_ -> Task.sleep (5*Time.second))
106− -- `Task.andThen` \_ -> Task.keepGoing
107− in
108− Native.Benchmark.runWithProgress ourTask suite
109−
110−{-|
111−Create a benchmark with the given name
112−running an arbitrary thunk
113−|-}
35+type Thunk = Thunk
36+
37+
38+{-| An individual benchmark with a name. It measures how long it takes to
39+evaluate the given function when it is passed a `()` value.
40+-}
11441bench : String -> (() -> result) -> Benchmark
115−bench = Native.Benchmark.makeBenchmark
116−
117−
118−{-|
119−Functions for creating named benchmarks with 1 to 9 arguments
120−|-}
121−bench1 : String -> (a -> result) -> a -> Benchmark
122−bench1 name f a =
123− Native.Benchmark.makeBenchmark name (\_ -> f a)
124−
125−
126−{-||-}
127−bench2 : String -> (a -> b -> result) -> a -> b -> Benchmark
128−bench2 name f a b =
129− Native.Benchmark.makeBenchmark name (\_ -> f a b)
130−
131−
132−{-||-}
133−bench3 : String -> (a -> b -> c -> result) -> a -> b -> c -> Benchmark
134−bench3 name f a b c =
135− Native.Benchmark.makeBenchmark name (\_ -> f a b c)
136−
137−
138−{-||-}
139−bench4 : String -> (a -> b -> c -> d -> result) -> a -> b -> c -> d -> Benchmark
140−bench4 name f a b c d =
141− Native.Benchmark.makeBenchmark name (\_ -> f a b c d)
142−
143−
144−{-||-}
145−bench5 : String -> (a -> b -> c -> d -> e -> result) -> a -> b -> c -> d -> e -> Benchmark
146−bench5 name f a b c d e =
147− Native.Benchmark.makeBenchmark name (\_ -> f a b c d e)
148−
149−
150−{-||-}
151−bench6 :
152− String
153− -> (a -> b -> c -> d -> e -> f -> result)
154− -> a
155− -> b
156− -> c
157− -> d
158− -> e
159− -> f
160− -> Benchmark
161−bench6 name fn a b c d e f =
162− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f)
163−
164−
165−{-||-}
166−bench7 :
167− String
168− -> (a -> b -> c -> d -> e -> f -> g -> result)
169− -> a
170− -> b
171− -> c
172− -> d
173− -> e
174− -> f
175− -> g
176− -> Benchmark
177−bench7 name fn a b c d e f g =
178− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g)
179−
180−
181−{-||-}
182−bench8 :
183− String
184− -> (a -> b -> c -> d -> e -> f -> g -> h -> result)
185− -> a
186− -> b
187− -> c
188− -> d
189− -> e
190− -> f
191− -> g
192− -> h
193− -> Benchmark
194−bench8 name fn a b c d e f g h =
195− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g h)
196−
197−{-||-}
198−bench9 :
199− String
200− -> (a -> b -> c -> d -> e -> f -> g -> h -> i -> result)
201− -> a
202− -> b
203− -> c
204− -> d
205− -> e
206− -> f
207− -> g
208− -> h
209− -> i
210− -> Benchmark
211−bench9 name fn a b c d e f g h i =
212− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g h i)
42+bench name thunk =
43+ Test name (Native.Benchmark.makeThunk thunk)
44+
45+
46+{-| A collection of benchmarks to run together.
47+-}
48+suite : String -> List Benchmark -> Benchmark
49+suite =
50+ Suite
51+
52+
53+
54+-- RUN THE BENCHMARKS
55+
56+
57+{-| Statistics -}
58+type Statistics
59+ = StatSuite String (List Statistics)
60+ | Result String
61+ { mean : Float
62+ }
63+
64+
65+{-| Run a benchmark.
66+-}
67+run : Benchmark -> Task.Task x Statistics
68+run =
69+ Native.Benchmark.run
70+
71+
72+
73+-- TO STRING
74+
75+
76+statisticsToString : Statistics -> String
77+statisticsToString statistics =
78+ List.join "\n" (statisticsToStringHelp statistics)
79+
80+
81+statisticsToStringHelp : Statistics -> (List String, Float)
82+statisticsToStringHelp statistics =
83+ case statistics of
84+ Result name {mean} ->
85+ ( [ name ++ " - " ++ toString mean ]
86+ , mean
87+ )
88+
89+ StatSuite name subStats ->
90+ let
91+ (strings, subMeans) =
92+ List.unzip (List.map statisticsToStringHelp subStats)
93+
94+ total =
95+ List.sum means
96+ in
97+ ( name ++ " - " ++ toString total
98+ :: List.map (String.padLeft 4 ' ') (List.concat strings)
99+ , total
100+ )