diff options
Diffstat (limited to 'benchmark/benchmark-pandoc.hs')
| -rw-r--r-- | benchmark/benchmark-pandoc.hs | 77 |
1 files changed, 55 insertions, 22 deletions
diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index e2707de20..489d5c39b 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE TupleSections #-} {- -Copyright (C) 2012-2014 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2012-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,38 +17,70 @@ along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} import Text.Pandoc +import qualified Text.Pandoc.UTF8 as UTF8 +import qualified Data.ByteString as B import Criterion.Main import Criterion.Types (Config(..)) +import Data.List (intersect) import Data.Maybe (mapMaybe) -import Debug.Trace (trace) +import System.Environment (getArgs) readerBench :: Pandoc - -> (String, ReaderOptions -> String -> IO (Either PandocError Pandoc)) + -> String -> Maybe Benchmark -readerBench doc (name, reader) = - case lookup name writers of - Just (PureStringWriter writer) -> - let inp = writer def{ writerWrapText = WrapAuto} doc - in return $ bench (name ++ " reader") $ nfIO $ - (fmap handleError <$> reader def{ readerSmart = True }) inp - _ -> trace ("\nCould not find writer for " ++ name ++ "\n") Nothing +readerBench doc name = + case res of + Right (readerFun, inp) -> + Just $ bench (name ++ " reader") + $ nf (\i -> either (error . show) id $ runPure (readerFun i)) + inp + Left _ -> Nothing + where res = runPure $ do + (TextReader r, rexts) + <- either (fail . show) return $ getReader name + (TextWriter w, wexts) + <- either (fail . show) return $ getWriter name + inp <- w def{ writerWrapText = WrapAuto, writerExtensions = wexts } + doc + return (r def{ readerExtensions = rexts }, inp) writerBench :: Pandoc - -> (String, WriterOptions -> Pandoc -> String) - -> Benchmark -writerBench doc (name, writer) = bench (name ++ " writer") $ nf - (writer def{ writerWrapText = WrapAuto }) doc + -> String + -> Maybe Benchmark +writerBench doc name = + case res of + Right writerFun -> + Just $ bench (name ++ " writer") + $ nf (\d -> either (error . show) id $ + runPure (writerFun d)) doc + _ -> Nothing + where res = runPure $ do + (TextWriter w, wexts) + <- either (fail . show) return $ getWriter name + return $ w def{ writerExtensions = wexts } main :: IO () main = do - inp <- readFile "tests/testsuite.txt" - let opts = def{ readerSmart = True } - let doc = handleError $ readMarkdown opts inp - let readers' = [(n,r) | (n, StringReader r) <- readers] + args <- filter (\x -> take 1 x /= "-") <$> getArgs + print args + let matchReader (n, TextReader _) = + null args || ("reader" `elem` args && n `elem` args) + matchReader _ = False + let matchWriter (n, TextWriter _) = + null args || ("writer" `elem` args && n `elem` args) + matchWriter _ = False + let matchedReaders = map fst $ (filter matchReader readers + :: [(String, Reader PandocPure)]) + let matchedWriters = map fst $ (filter matchWriter writers + :: [(String, Writer PandocPure)]) + inp <- UTF8.toText <$> B.readFile "test/testsuite.txt" + let opts = def + let doc = either (error . show) id $ runPure $ readMarkdown opts inp let readerBs = mapMaybe (readerBench doc) - $ filter (\(n,_) -> n /="haddock") readers' - let writers' = [(n,w) | (n, PureStringWriter w) <- writers] - let writerBs = map (writerBench doc) - $ writers' + $ filter (/="haddock") + (matchedReaders `intersect` matchedWriters) + -- we need the corresponding writer to generate + -- input for the reader + let writerBs = mapMaybe (writerBench doc) matchedWriters defaultMainWith defaultConfig{ timeLimit = 6.0 } (writerBs ++ readerBs) |