diff options
Diffstat (limited to 'benchmark/benchmark-pandoc.hs')
| -rw-r--r-- | benchmark/benchmark-pandoc.hs | 60 |
1 files changed, 35 insertions, 25 deletions
diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 967728f5d..3e7b663b4 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} {- Copyright (C) 2012-2019 John MacFarlane <jgm@berkeley.edu> @@ -21,39 +20,49 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA import Prelude import Text.Pandoc import Text.Pandoc.MIME -import Text.Pandoc.Error (PandocError(..)) -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, liftIO) import qualified Text.Pandoc.UTF8 as UTF8 import qualified Data.ByteString as B import qualified Data.Text as T import Criterion.Main import Criterion.Types (Config(..)) import Data.List (intersect) -import Data.Maybe (mapMaybe) +import Data.Maybe (mapMaybe, catMaybes) import System.Environment (getArgs) import qualified Data.ByteString.Lazy as BL +data Input = InputText {unInputText :: T.Text} + | InputBS {unInputBS :: BL.ByteString} + readerBench :: Pandoc -> T.Text - -> Maybe Benchmark -readerBench doc name = - case res of - Right (readerFun, inp) -> - Just $ bench (T.unpack $ name <> " reader") - $ nf (\i -> either (error . show) id $ runPure (readerFun i)) - inp - Left _ -> Nothing - where res = runPure $ do - (rdr, rexts) <- getReader name + -> IO (Maybe Benchmark) +readerBench doc name = do + let (rdr, rexts) = either (error . show) id . runPure $ getReader name + res <- runIO $ do (wtr, wexts) <- getWriter name case (rdr, wtr) of (TextReader r, TextWriter w) -> do - setResourcePath ["../test"] + setResourcePath ["./test"] inp <- w def{ writerWrapText = WrapAuto , writerExtensions = wexts } doc - return $ (r def{ readerExtensions = rexts }, inp) - _ -> throwError $ PandocSomeError $ "not a text format: " + return (r def{ readerExtensions = rexts } . unInputText, InputText inp) + (ByteStringReader r, ByteStringWriter w) -> do + setResourcePath ["./test"] + tmpl <- Just <$> compileDefaultTemplate name + inp <- w def{ writerWrapText = WrapAuto + , writerExtensions = wexts + , writerTemplate = tmpl } doc + liftIO $ BL.writeFile "/tmp/test.odt" inp + return (r def{ readerExtensions = rexts } . unInputBS, InputBS inp) + _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: " <> name + return $ case res of + Right (readerFun, inp) -> + Just $ bench (T.unpack $ name <> " reader") + $ nf (\i -> either (error . show) id $ runPure (readerFun i)) + inp + Left _ -> Nothing getImages :: IO [(FilePath, MimeType, BL.ByteString)] getImages = do @@ -89,22 +98,23 @@ main :: IO () main = do args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs print args - let matchReader (n, TextReader _) = + let matchReader (n, _) = null args || ("reader" `elem` args && n `elem` args) - matchReader _ = False - let matchWriter (n, TextWriter _) = + matchWriter (n, TextWriter _) = null args || ("writer" `elem` args && n `elem` args) matchWriter _ = False - let matchedReaders = map fst $ (filter matchReader readers + allWriters = map fst (writers :: [(T.Text, Writer PandocPure)]) + matchedReaders = map fst (filter matchReader readers :: [(T.Text, Reader PandocPure)]) - let matchedWriters = map fst $ (filter matchWriter writers + matchedWriters = map fst (filter matchWriter writers :: [(T.Text, 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 (/="haddock") - (matchedReaders `intersect` matchedWriters) + readerBs <- fmap catMaybes + $ mapM (readerBench doc) + $ filter (/="haddock") + (matchedReaders `intersect` allWriters) -- we need the corresponding writer to generate -- input for the reader let writerBs = mapMaybe (writerBench doc) matchedWriters |