benchmark: allow benchmark arguments.

These pattern match: so, '--benchmark-arguments "markdown reader"'
will only benchmark the markdown reader; with just "markdown" it
will do the writer too; with no arguments all benchmarks are run.
This commit is contained in:
John MacFarlane 2017-01-27 11:29:26 +01:00
parent 8a61d943f5
commit 86b9a51ee3

View file

@ -24,6 +24,7 @@ import Criterion.Main
import Criterion.Types (Config(..))
import Data.Maybe (mapMaybe)
import Debug.Trace (trace)
import System.Environment (getArgs)
readerBench :: Pandoc
-> (String, ReaderOptions -> String -> Pandoc)
@ -45,6 +46,21 @@ writerBench doc (name, writer) = bench (name ++ " writer") $ nf
main :: IO ()
main = do
args <- getArgs
let matchReader (n, StringReader _) =
case args of
[] -> True
[x] -> x == n
(x:y:_) -> x == n && y == "reader"
matchReader (_, _) = False
let matchWriter (n, StringWriter _) =
case args of
[] -> True
[x] -> x == n
(x:y:_) -> x == n && y == "writer"
matchWriter (_, _) = False
let matchedReaders = filter matchReader readers
let matchedWriters = filter matchWriter writers
inp <- readFile "tests/testsuite.txt"
lalune <- B.readFile "tests/lalune.jpg"
movie <- B.readFile "tests/movie.jpg"
@ -58,12 +74,12 @@ main = do
let doc = either (error . show) id $ runPure $ readMarkdown opts inp
let readers' = [(n, \o d ->
either (error . show) id $ runPure $ r o d)
| (n, StringReader r) <- readers]
| (n, StringReader r) <- matchedReaders]
let readerBs = mapMaybe (readerBench doc)
$ filter (\(n,_) -> n /="haddock") readers'
let writers' = [(n, \o d ->
either (error . show) id $ runPure $ setupFakeFiles >> w o d)
| (n, StringWriter w) <- writers]
| (n, StringWriter w) <- matchedWriters]
let writerBs = map (writerBench doc)
$ writers'
defaultMainWith defaultConfig{ timeLimit = 6.0 }