git.iko.soy/typeable/pandoc
on lowmem help sign in
typeable/pandoc/benchmark/benchmark-pandoc.hs
102 lines 4.1 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-
3Copyright (C) 2012-2021 John MacFarlane <jgm@berkeley.edu>
5This program is free software; you can redistribute it and/or modify
6it under the terms of the GNU General Public License as published by
7the Free Software Foundation; either version 2 of the License, or
8(at your option) any later version.
10This program is distributed in the hope that it will be useful,
11but WITHOUT ANY WARRANTY; without even the implied warranty of
12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13GNU General Public License for more details.
15You should have received a copy of the GNU General Public License
16along with this program; if not, write to the Free Software
17Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18-}
19import Text.Pandoc
20import Text.Pandoc.MIME
21import Control.Monad (when)
22import Control.Monad.Except (throwError)
23import qualified Text.Pandoc.UTF8 as UTF8
24import qualified Data.ByteString as B
25import qualified Data.Text as T
26import Test.Tasty.Bench
27import qualified Data.ByteString.Lazy as BL
28import Data.Maybe (mapMaybe)
29import Data.List (sortOn)
31readerBench :: Pandoc
32 -> T.Text
33 -> Maybe Benchmark
34readerBench doc name = either (const Nothing) Just $
35 runPure $ do
36 when (name `elem` ["bibtex", "biblatex", "csljson"]) $
37 throwError $ PandocSomeError $ name <> " not supported for benchmark"
38 (rdr, rexts) <- getReader name
39 (wtr, wexts) <- getWriter name
40 case (rdr, wtr) of
41 (TextReader r, TextWriter w) -> do
42 inp <- w def{ writerWrapText = WrapAuto
43 , writerExtensions = wexts } doc
44 return $ bench (T.unpack name) $
45 nf (either (error . show) id . runPure . r def) inp
46 (ByteStringReader r, ByteStringWriter w) -> do
47 tmpl <- Just <$> compileDefaultTemplate name
48 inp <- w def{ writerWrapText = WrapAuto
49 , writerExtensions = wexts
50 , writerTemplate = tmpl } doc
51 return $ bench (T.unpack name) $
52 nf (either (error . show) id .
53 runPure . r def{readerExtensions = rexts}) inp
54 _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "
55 <> name
57getImages :: IO [(FilePath, MimeType, BL.ByteString)]
58getImages = do
59 ll <- BL.readFile "test/lalune.jpg"
60 mv <- BL.readFile "test/movie.jpg"
61 return [("lalune.jpg", "image/jpg", ll)
62 ,("movie.jpg", "image/jpg", mv)]
64writerBench :: [(FilePath, MimeType, BL.ByteString)]
65 -> Pandoc
66 -> T.Text
67 -> Maybe Benchmark
68writerBench imgs doc name = either (const Nothing) Just $
69 runPure $ do
70 when (name `elem` ["bibtex", "biblatex", "csljson"]) $
71 throwError $ PandocSomeError $ name <> " not supported for benchmark"
72 (wtr, wexts) <- getWriter name
73 case wtr of
74 TextWriter writerFun ->
75 return $ bench (T.unpack name)
76 $ nf (\d -> either (error . show) id $
77 runPure $ do
78 mapM_ (\(fp,mt,bs) -> insertMedia fp (Just mt) bs) imgs
79 writerFun def{ writerExtensions = wexts} d)
80 doc
81 ByteStringWriter writerFun ->
82 return $ bench (T.unpack name)
83 $ nf (\d -> either (error . show) id $
84 runPure $ do
85 mapM_ (\(fp,mt,bs) -> insertMedia fp (Just mt) bs) imgs
86 writerFun def{ writerExtensions = wexts} d)
87 doc
89main :: IO ()
90main = do
91 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
92 let opts = def
93 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
94 imgs <- getImages
95 defaultMain
96 [ bgroup "writers" $ mapMaybe (writerBench imgs doc . fst)
97 (sortOn fst
98 writers :: [(T.Text, Writer PandocPure)])
99 , bgroup "readers" $ mapMaybe (readerBench doc . fst)
100 (sortOn fst
101 readers :: [(T.Text, Reader PandocPure)])
102 ]