diff options
| -rw-r--r-- | benchmark/benchmark-pandoc.hs | 35 |
1 files changed, 20 insertions, 15 deletions
diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 9238b09d7..294d385dd 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -20,19 +20,20 @@ import Criterion.Main import Criterion.Config import System.Environment (getArgs) import Data.Monoid +import Data.Maybe (mapMaybe) +import Debug.Trace (trace) readerBench :: Pandoc -> (String, ReaderOptions -> String -> IO Pandoc) - -> Benchmark -readerBench doc (name, reader) = - let writer = case lookup name writers of - Just (PureStringWriter w) -> w - _ -> error $ "Could not find writer for " ++ name - inp = writer def{ writerWrapText = True } doc - -- we compute the length to force full evaluation - getLength (Pandoc (Meta _) d) = length d - in bench (name ++ " reader") $ whnfIO $ getLength `fmap` - (reader def{ readerSmart = True }) inp + -> Maybe Benchmark +readerBench doc (name, reader) = case lookup name writers of + Just (PureStringWriter writer) -> + let inp = writer def{ writerWrapText = True} doc + -- we compute the length to force full evaluation + getLength (Pandoc (Meta _) d) = length d + in return $ bench (name ++ " reader") $ whnfIO $ getLength `fmap` + (reader def{ readerSmart = True }) inp + _ -> trace ("\nCould not find writer for " ++ name ++ "\n") Nothing writerBench :: Pandoc -> (String, WriterOptions -> Pandoc -> String) @@ -43,13 +44,17 @@ writerBench doc (name, writer) = bench (name ++ " writer") $ nf main :: IO () main = do args <- getArgs - (conf,_) <- parseArgs defaultConfig{ cfgSamples = Last $ Just 20 } defaultOptions args - inp <- readFile "README" + (conf,_) <- parseArgs defaultConfig{ cfgSamples = Last $ Just 20 } + defaultOptions args + inp <- readFile "README" inp2 <- readFile "tests/testsuite.txt" let opts = def{ readerSmart = True } let doc = readMarkdown opts $ inp ++ unlines (drop 3 $ lines inp2) - let readerBs = map (readerBench doc) - $ filter (\(n,_) -> n /="haddock") readers + let readers' = [(n,r) | (n, StringReader r) <- readers] + let readerBs = mapMaybe (readerBench doc) + $ filter (\(n,_) -> n /="haddock") readers' let writers' = [(n,w) | (n, PureStringWriter w) <- writers] + let writerBs = map (writerBench doc) + $ writers' defaultMainWith conf (return ()) $ - map (writerBench doc) writers' ++ readerBs + writerBs ++ readerBs |