git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #6508 from lierdakil/bench-bs-readers
20aea4cJohn MacFarlane
benchmark/benchmark-pandoc.hs+35−25
compare with master
unifiedsplit
@@ -1,6 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TupleSections #-}
4{-
3{-
5Copyright (C) 2012-2019 John MacFarlane <jgm@berkeley.edu>
4Copyright (C) 2012-2019 John MacFarlane <jgm@berkeley.edu>
6
5
@@ -21,39 +20,49 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21import Prelude
20import Prelude
22import Text.Pandoc
21import Text.Pandoc
23import Text.Pandoc.MIME
22import Text.Pandoc.MIME
24−import Text.Pandoc.Error (PandocError(..))
25−import Control.Monad.Except (throwError)
23+import Control.Monad.Except (throwError, liftIO)
26import qualified Text.Pandoc.UTF8 as UTF8
24import qualified Text.Pandoc.UTF8 as UTF8
27import qualified Data.ByteString as B
25import qualified Data.ByteString as B
28import qualified Data.Text as T
26import qualified Data.Text as T
29import Criterion.Main
27import Criterion.Main
30import Criterion.Types (Config(..))
28import Criterion.Types (Config(..))
31import Data.List (intersect)
29import Data.List (intersect)
32−import Data.Maybe (mapMaybe)
30+import Data.Maybe (mapMaybe, catMaybes)
33import System.Environment (getArgs)
31import System.Environment (getArgs)
34import qualified Data.ByteString.Lazy as BL
32import qualified Data.ByteString.Lazy as BL
35
33
34+data Input = InputText {unInputText :: T.Text}
35+ | InputBS {unInputBS :: BL.ByteString}
36+
36readerBench :: Pandoc
37readerBench :: Pandoc
37 -> T.Text
38 -> T.Text
38− -> Maybe Benchmark
39+ -> IO (Maybe Benchmark)
39−readerBench doc name =
40+readerBench doc name = do
40− case res of
41− Right (readerFun, inp) ->
42− Just $ bench (T.unpack $ name <> " reader")
43− $ nf (\i -> either (error . show) id $ runPure (readerFun i))
41+ let (rdr, rexts) = either (error . show) id . runPure $ getReader name
44− inp
42+ res <- runIO $ do
45− Left _ -> Nothing
46− where res = runPure $ do
47− (rdr, rexts) <- getReader name
48 (wtr, wexts) <- getWriter name
43 (wtr, wexts) <- getWriter name
49 case (rdr, wtr) of
44 case (rdr, wtr) of
50 (TextReader r, TextWriter w) -> do
45 (TextReader r, TextWriter w) -> do
51− setResourcePath ["../test"]
46+ setResourcePath ["./test"]
52 inp <- w def{ writerWrapText = WrapAuto
47 inp <- w def{ writerWrapText = WrapAuto
53 , writerExtensions = wexts } doc
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
54− return $ (r def{ readerExtensions = rexts }, inp)
57+ return (r def{ readerExtensions = rexts } . unInputBS, InputBS inp)
55− _ -> throwError $ PandocSomeError $ "not a text format: "
58+ _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "
56 <> name
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
57
66
58getImages :: IO [(FilePath, MimeType, BL.ByteString)]
67getImages :: IO [(FilePath, MimeType, BL.ByteString)]
59getImages = do
68getImages = do
@@ -89,22 +98,23 @@ main :: IO ()
89main = do
98main = do
90 args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs
99 args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs
91 print args
100 print args
92− let matchReader (n, TextReader _) =
101+ let matchReader (n, _) =
93 null args || ("reader" `elem` args && n `elem` args)
102 null args || ("reader" `elem` args && n `elem` args)
94− matchReader _ = False
95− let matchWriter (n, TextWriter _) =
103+ matchWriter (n, TextWriter _) =
96 null args || ("writer" `elem` args && n `elem` args)
104 null args || ("writer" `elem` args && n `elem` args)
97 matchWriter _ = False
105 matchWriter _ = False
106+ allWriters = map fst (writers :: [(T.Text, Writer PandocPure)])
98− let matchedReaders = map fst $ (filter matchReader readers
107+ matchedReaders = map fst (filter matchReader readers
99 :: [(T.Text, Reader PandocPure)])
108 :: [(T.Text, Reader PandocPure)])
100− let matchedWriters = map fst $ (filter matchWriter writers
109+ matchedWriters = map fst (filter matchWriter writers
101 :: [(T.Text, Writer PandocPure)])
110 :: [(T.Text, Writer PandocPure)])
102 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
111 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
103 let opts = def
112 let opts = def
104 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
113 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
114+ readerBs <- fmap catMaybes
105− let readerBs = mapMaybe (readerBench doc)
115+ $ mapM (readerBench doc)
106− $ filter (/="haddock")
116+ $ filter (/="haddock")
107− (matchedReaders `intersect` matchedWriters)
117+ (matchedReaders `intersect` allWriters)
108 -- we need the corresponding writer to generate
118 -- we need the corresponding writer to generate
109 -- input for the reader
119 -- input for the reader
110 let writerBs = mapMaybe (writerBench doc) matchedWriters
120 let writerBs = mapMaybe (writerBench doc) matchedWriters