@@ -20,19 +20,20 @@ import Criterion.Main
20import Criterion.Config
20import Criterion.Config
21import System.Environment (getArgs)
21import System.Environment (getArgs)
22import Data.Monoid
22import Data.Monoid
23+import Data.Maybe (mapMaybe)
24+import Debug.Trace (trace)
24readerBench :: Pandoc
26readerBench :: Pandoc
25 -> (String, ReaderOptions -> String -> IO Pandoc)
27 -> (String, ReaderOptions -> String -> IO Pandoc)
26− -> Benchmark
28+ -> Maybe Benchmark
27−readerBench doc (name, reader) =
29+readerBench doc (name, reader) = case lookup name writers of
28− let writer = case lookup name writers of
29− Just (PureStringWriter w) -> w
30+ Just (PureStringWriter writer) ->
30− _ -> error $ "Could not find writer for " ++ name
31− inp = writer def{ writerWrapText = True } doc
31+ let inp = writer def{ writerWrapText = True} doc
32− -- we compute the length to force full evaluation
32+ -- we compute the length to force full evaluation
33− getLength (Pandoc (Meta _) d) = length d
33+ getLength (Pandoc (Meta _) d) = length d
34− in bench (name ++ " reader") $ whnfIO $ getLength `fmap`
34+ in return $ bench (name ++ " reader") $ whnfIO $ getLength `fmap`
35− (reader def{ readerSmart = True }) inp
35+ (reader def{ readerSmart = True }) inp
36+ _ -> trace ("\nCould not find writer for " ++ name ++ "\n") Nothing
37writerBench :: Pandoc
38writerBench :: Pandoc
38 -> (String, WriterOptions -> Pandoc -> String)
39 -> (String, WriterOptions -> Pandoc -> String)
@@ -43,13 +44,17 @@ writerBench doc (name, writer) = bench (name ++ " writer") $ nf
43main :: IO ()
44main :: IO ()
45 args <- getArgs
46 args <- getArgs
46− (conf,_) <- parseArgs defaultConfig{ cfgSamples = Last $ Just 20 } defaultOptions args
47+ (conf,_) <- parseArgs defaultConfig{ cfgSamples = Last $ Just 20 }
47− inp <- readFile "README"
49+ inp <- readFile "README"
48 inp2 <- readFile "tests/testsuite.txt"
50 inp2 <- readFile "tests/testsuite.txt"
49 let opts = def{ readerSmart = True }
51 let opts = def{ readerSmart = True }
50 let doc = readMarkdown opts $ inp ++ unlines (drop 3 $ lines inp2)
52 let doc = readMarkdown opts $ inp ++ unlines (drop 3 $ lines inp2)
53+ let readers' = [(n,r) | (n, StringReader r) <- readers]
51− let readerBs = map (readerBench doc)
54+ let readerBs = mapMaybe (readerBench doc)
52− $ filter (\(n,_) -> n /="haddock") readers
55+ $ filter (\(n,_) -> n /="haddock") readers'
53 let writers' = [(n,w) | (n, PureStringWriter w) <- writers]
56 let writers' = [(n,w) | (n, PureStringWriter w) <- writers]
57+ let writerBs = map (writerBench doc)
54 defaultMainWith conf (return ()) $
59 defaultMainWith conf (return ()) $
55− map (writerBench doc) writers' ++ readerBs
60+ writerBs ++ readerBs