git.iko.soy/typeable/pandoc
on commonmark-hs-new help sign in
typeable/pandoc/benchmark/benchmark-pandoc.hs
122 lines 5.1 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-
4Copyright (C) 2012-2019 John MacFarlane <jgm@berkeley.edu>
6This program is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2 of the License, or
9(at your option) any later version.
11This program is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
16You should have received a copy of the GNU General Public License
17along with this program; if not, write to the Free Software
18Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19-}
20import Prelude
21import Text.Pandoc
22import Text.Pandoc.MIME
23import Control.Monad.Except (throwError, liftIO)
24import qualified Text.Pandoc.UTF8 as UTF8
25import qualified Data.ByteString as B
26import qualified Data.Text as T
27import Criterion.Main
28import Criterion.Types (Config(..))
29import Data.List (intersect)
30import Data.Maybe (mapMaybe, catMaybes)
31import System.Environment (getArgs)
32import qualified Data.ByteString.Lazy as BL
34data Input = InputText {unInputText :: T.Text}
35 | InputBS {unInputBS :: BL.ByteString}
37readerBench :: Pandoc
38 -> T.Text
39 -> IO (Maybe Benchmark)
40readerBench doc name = do
41 let (rdr, rexts) = either (error . show) id . runPure $ getReader name
42 res <- runIO $ do
43 (wtr, wexts) <- getWriter name
44 case (rdr, wtr) of
45 (TextReader r, TextWriter w) -> do
46 setResourcePath ["./test"]
47 inp <- w def{ writerWrapText = WrapAuto
48 , writerExtensions = wexts } doc
49 return (r def{ readerExtensions = rexts } . unInputText, InputText inp)
50 (ByteStringReader r, ByteStringWriter w) -> do
51 setResourcePath ["./test"]
52 tmpl <- Just <$> compileDefaultTemplate name
53 inp <- w def{ writerWrapText = WrapAuto
54 , writerExtensions = wexts
55 , writerTemplate = tmpl } doc
56 liftIO $ BL.writeFile "/tmp/test.odt" inp
57 return (r def{ readerExtensions = rexts } . unInputBS, InputBS inp)
58 _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "
59 <> name
60 return $ case res of
61 Right (readerFun, inp) ->
62 Just $ bench (T.unpack $ name <> " reader")
63 $ nf (\i -> either (error . show) id $ runPure (readerFun i))
64 inp
65 Left _ -> Nothing
67getImages :: IO [(FilePath, MimeType, BL.ByteString)]
68getImages = do
69 ll <- BL.readFile "test/lalune.jpg"
70 mv <- BL.readFile "test/movie.jpg"
71 return [("lalune.jpg", "image/jpg", ll)
72 ,("movie.jpg", "image/jpg", mv)]
74writerBench :: Pandoc
75 -> T.Text
76 -> Maybe Benchmark
77writerBench doc name =
78 case res of
79 Right writerFun ->
80 Just $ env getImages $ \imgs ->
81 bench (T.unpack $ name <> " writer")
82 $ nf (\d -> either (error . show) id $
83 runPure (do mapM_
84 (\(fp, mt, bs) ->
85 insertMedia fp (Just mt) bs)
86 imgs
87 writerFun d)) doc
88 Left _ -> Nothing
89 where res = runPure $ do
90 (wtr, wexts) <- getWriter name
91 case wtr of
92 TextWriter w ->
93 return $ w def{ writerExtensions = wexts }
94 _ -> throwError $ PandocSomeError
95 $ "could not get text writer for " <> name
97main :: IO ()
98main = do
99 args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs
100 print args
101 let matchReader (n, _) =
102 null args || ("reader" `elem` args && n `elem` args)
103 matchWriter (n, TextWriter _) =
104 null args || ("writer" `elem` args && n `elem` args)
105 matchWriter _ = False
106 allWriters = map fst (writers :: [(T.Text, Writer PandocPure)])
107 matchedReaders = map fst (filter matchReader readers
108 :: [(T.Text, Reader PandocPure)])
109 matchedWriters = map fst (filter matchWriter writers
110 :: [(T.Text, Writer PandocPure)])
111 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
112 let opts = def
113 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
114 readerBs <- fmap catMaybes
115 $ mapM (readerBench doc)
116 $ filter (/="haddock")
117 (matchedReaders `intersect` allWriters)
118 -- we need the corresponding writer to generate
119 -- input for the reader
120 let writerBs = mapMaybe (writerBench doc) matchedWriters
121 defaultMainWith defaultConfig{ timeLimit = 6.0 }
122 (writerBs ++ readerBs)