Skip to content

Commit 0224b59

Browse files
jamesdbrockjamesdbrock
committed
Bench throw on parse failure
1 parent d9ccd4f commit 0224b59

File tree

1 file changed

+43
-34
lines changed

1 file changed

+43
-34
lines changed

‎bench/Main.purs‎

Lines changed: 43 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,10 @@ import Control.Monad.Free (liftF)
6060
import Control.Monad.Trampoline (runTrampoline)
6161
import Data.Array (fold, replicate)
6262
import Data.Array as Array
63-
import Data.Either (either)
63+
import Data.Either (Either(..), either)
6464
import Data.List (many, manyRec)
6565
import Data.List.Types (List)
66+
import Data.Maybe (Maybe(..))
6667
import Data.String.Regex (Regex, regex)
6768
import Data.String.Regex as Regex
6869
import Data.String.Regex.Flags (RegexFlags(..))
@@ -157,6 +158,14 @@ htmlTableWrap caption benchmark = do
157158
benchmark
158159
log "</pre></td>"
159160

161+
throwLeft :: forall a b. Show a => Either a b -> b
162+
throwLeft (Left err) = unsafePerformEffect $ throw $ show err
163+
throwLeft (Right x) = x
164+
165+
throwNothing :: forall a. String -> Maybe a -> a
166+
throwNothing err Nothing = unsafePerformEffect $ throw err
167+
throwNothing _ (Just x) = x
168+
160169
main :: Effect Unit
161170
main = do
162171
log "<tr>"
@@ -180,90 +189,90 @@ main = do
180189

181190
log "<th><h2>digit 10000</h2></th>"
182191
htmlTableWrap "runParser many digit 10000" $ benchWith 50
183-
$ \_ -> runParser string23_10000 parse23
192+
$ \_ -> throwLeft $ runParser string23_10000 parse23
184193
htmlTableWrap "runParser manyRec digit 10000" $ benchWith 50
185-
$ \_ -> runParser string23_10000 parse23Rec
194+
$ \_ -> throwLeft $ runParser string23_10000 parse23Rec
186195
htmlTableWrap "runParser Array.many digit 10000" $ benchWith 50
187-
$ \_ -> runParser string23_10000 (Array.many digit)
196+
$ \_ -> throwLeft $ runParser string23_10000 (Array.many digit)
188197
htmlTableWrap "StringParser manyRec CodePoints.anyDigit 10000" $ benchWith 20
189-
$ \_ -> StringParser.runParser parse23PointsRec string23_10000
198+
$ \_ -> throwLeft $ StringParser.runParser parse23PointsRec string23_10000
190199
htmlTableWrap "StringParser manyRec CodeUnits.anyDigit 10000" $ benchWith 200
191-
$ \_ -> StringParser.runParser parse23UnitsRec string23_10000
200+
$ \_ -> throwLeft $ StringParser.runParser parse23UnitsRec string23_10000
192201
htmlTableWrap "Regex.match \\d* 10000" $ benchWith 200
193-
$ \_ -> Regex.match pattern23 string23_10000
202+
$ \_ -> throwNothing "Regex.match failed" $ Regex.match pattern23 string23_10000
194203

195204
log "<th><h2>string 100000</h2></th>"
196205
htmlTableWrap "runParser many string" $ benchWith 200
197-
$ \_ -> runParser stringSkidoo_100000 parseSkidoo
206+
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidoo
198207
htmlTableWrap "runParser manyRec string" $ benchWith 200
199-
$ \_ -> runParser stringSkidoo_100000 parseSkidooRec
208+
$ \_ -> throwLeft $ runParser stringSkidoo_100000 parseSkidooRec
200209
htmlTableWrap "Regex.match literal*" $ benchWith 200
201-
$ \_ -> Regex.match patternSkidoo stringSkidoo_100000
210+
$ \_ -> throwNothing "Regex.match failed" $ Regex.match patternSkidoo stringSkidoo_100000
202211

203212
log "<th><h2>sepBy 1000</h2></th>"
204213
htmlTableWrap "runParser sepBy 1000" $ benchWith 50
205-
$ \_ -> runParser string23_1000 $ sepBy anyChar (char '3')
214+
$ \_ -> throwLeft $ runParser string23_1000 $ sepBy anyChar (char '3')
206215
htmlTableWrap "runParser sepByRec 1000" $ benchWith 50
207-
$ \_ -> runParser string23_1000 $ sepByRec anyChar (char '3')
216+
$ \_ -> throwLeft $ runParser string23_1000 $ sepByRec anyChar (char '3')
208217

209218
log "<th><h2>sepBy 10000</h2></th>"
210219
htmlTableWrap "runParser sepBy 10000" $ benchWith 50
211-
$ \_ -> runParser string23_10000 $ sepBy anyChar (char '3')
220+
$ \_ -> throwLeft $ runParser string23_10000 $ sepBy anyChar (char '3')
212221
htmlTableWrap "runParser sepByRec 10000" $ benchWith 50
213-
$ \_ -> runParser string23_10000 $ sepByRec anyChar (char '3')
222+
$ \_ -> throwLeft $ runParser string23_10000 $ sepByRec anyChar (char '3')
214223

215224
log "<th><h2>chainl 10000</h2></th>"
216225
htmlTableWrap "runParser chainl 10000" $ benchWith 50
217-
$ \_ -> runParser string23_10000 $ chainl anyChar (pure const) 'x'
226+
$ \_ -> throwLeft $ runParser string23_10000 $ chainl anyChar (pure const) 'x'
218227
htmlTableWrap "runParser chainlRec 10000" $ benchWith 50
219-
$ \_ -> runParser string23_10000 $ chainlRec anyChar (pure const) 'x'
228+
$ \_ -> throwLeft $ runParser string23_10000 $ chainlRec anyChar (pure const) 'x'
220229

221230
log "<th><h2>chainr 1000</h2></th>"
222231
htmlTableWrap "runParser chainr 1000" $ benchWith 5
223-
$ \_ -> runParser string23_1000 $ chainr anyChar (pure const) 'x'
232+
$ \_ -> throwLeft $ runParser string23_1000 $ chainr anyChar (pure const) 'x'
224233
htmlTableWrap "runParser chainrRec 1000" $ benchWith 5
225-
$ \_ -> runParser string23_1000 $ chainrRec anyChar (pure const) 'x'
234+
$ \_ -> throwLeft $ runParser string23_1000 $ chainrRec anyChar (pure const) 'x'
226235

227236
log "<th><h2>chainr 10000</h2></th>"
228237
htmlTableWrap "runParser chainr 10000" $ benchWith 5
229-
$ \_ -> runParser string23_10000 $ chainr anyChar (pure const) 'x'
238+
$ \_ -> throwLeft $ runParser string23_10000 $ chainr anyChar (pure const) 'x'
230239
htmlTableWrap "runParser chainrRec 10000" $ benchWith 5
231-
$ \_ -> runParser string23_10000 $ chainrRec anyChar (pure const) 'x'
240+
$ \_ -> throwLeft $ runParser string23_10000 $ chainrRec anyChar (pure const) 'x'
232241

233242
log "<th><h2>manyTill 1000</h2></th>"
234243
htmlTableWrap "runParser manyTill 1000" $ benchWith 50
235-
$ \_ -> runParser string23_1000x $ manyTill anyChar (char 'x')
244+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTill anyChar (char 'x')
236245
htmlTableWrap "runParser manyTillRec 1000" $ benchWith 50
237-
$ \_ -> runParser string23_1000x $ manyTillRec anyChar (char 'x')
246+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTillRec anyChar (char 'x')
238247
htmlTableWrap "runParser manyTill_ 1000" $ benchWith 50
239-
$ \_ -> runParser string23_1000x $ manyTill_ anyChar (char 'x')
248+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTill_ anyChar (char 'x')
240249
htmlTableWrap "runParser manyTillRec_ 1000" $ benchWith 50
241-
$ \_ -> runParser string23_1000x $ manyTillRec_ anyChar (char 'x')
250+
$ \_ -> throwLeft $ runParser string23_1000x $ manyTillRec_ anyChar (char 'x')
242251

243252
log "<th><h2>manyTill 10000</h2></th>"
244253
htmlTableWrap "runParser manyTill 10000" $ benchWith 50
245-
$ \_ -> runParser string23_10000x $ manyTill anyChar (char 'x')
254+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTill anyChar (char 'x')
246255
htmlTableWrap "runParser manyTillRec 10000" $ benchWith 50
247-
$ \_ -> runParser string23_10000x $ manyTillRec anyChar (char 'x')
256+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTillRec anyChar (char 'x')
248257
htmlTableWrap "runParser manyTill_ 10000" $ benchWith 50
249-
$ \_ -> runParser string23_10000x $ manyTill_ anyChar (char 'x')
258+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTill_ anyChar (char 'x')
250259
htmlTableWrap "runParser manyTillRec_ 10000" $ benchWith 50
251-
$ \_ -> runParser string23_10000x $ manyTillRec_ anyChar (char 'x')
260+
$ \_ -> throwLeft $ runParser string23_10000x $ manyTillRec_ anyChar (char 'x')
252261

253262
log "<th><h2>mediumJson</h2></th>"
254263
htmlTableWrap "runParser json mediumJson" $ benchWith 500
255-
$ \_ -> runParser mediumJson BenchParsing.json
264+
$ \_ -> throwLeft $ runParser mediumJson BenchParsing.json
256265
htmlTableWrap "runTrampoline runParser json mediumJson" $ benchWith 500
257-
$ \_ -> runTrampoline $ runParserT mediumJson BenchParsing.json
266+
$ \_ -> throwLeft $ runTrampoline $ runParserT mediumJson BenchParsing.json
258267
htmlTableWrap "StringParser.runParser json mediumJson" $ benchWith 1000
259-
$ \_ -> StringParser.runParser BenchStringParser.json mediumJson
268+
$ \_ -> throwLeft $ StringParser.runParser BenchStringParser.json mediumJson
260269

261270
log "<th><h2>largeJson</h2></th>"
262271
htmlTableWrap "runParser json largeJson" $ benchWith 100
263-
$ \_ -> runParser largeJson BenchParsing.json
272+
$ \_ -> throwLeft $ runParser largeJson BenchParsing.json
264273
htmlTableWrap "runTrampoline runParser json largeJson" $ benchWith 100
265-
$ \_ -> runTrampoline $ runParserT largeJson BenchParsing.json
274+
$ \_ -> throwLeft $ runTrampoline $ runParserT largeJson BenchParsing.json
266275
htmlTableWrap "StringParser.runParser json largeJson" $ benchWith 100
267-
$ \_ -> StringParser.runParser BenchStringParser.json largeJson
276+
$ \_ -> throwLeft $ StringParser.runParser BenchStringParser.json largeJson
268277
log "</tr>"
269278

0 commit comments

Comments
 (0)