@@ -1,6 +1,5 @@
11{-# LANGUAGE NoImplicitPrelude #-}
22{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TupleSections #-}
43{-
54Copyright (C) 2012-2019 John MacFarlane <jgm@berkeley.edu>
65
@@ -21,39 +20,49 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2120import Prelude
2221import Text.Pandoc
2322import Text.Pandoc.MIME
24−import Text.Pandoc.Error (PandocError(..))
25−import Control.Monad.Except (throwError)
23+import Control.Monad.Except (throwError, liftIO)
2624import qualified Text.Pandoc.UTF8 as UTF8
2725import qualified Data.ByteString as B
2826import qualified Data.Text as T
2927import Criterion.Main
3028import Criterion.Types (Config(..))
3129import Data.List (intersect)
32−import Data.Maybe (mapMaybe)
30+import Data.Maybe (mapMaybe, catMaybes)
3331import System.Environment (getArgs)
3432import qualified Data.ByteString.Lazy as BL
3533
34+data Input = InputText {unInputText :: T.Text}
35+ | InputBS {unInputBS :: BL.ByteString}
36+
3637readerBench :: Pandoc
3738 -> T.Text
38− -> Maybe Benchmark
39−readerBench doc name =
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))
44− inp
45− Left _ -> Nothing
46− where res = runPure $ do
47− (rdr, rexts) <- getReader name
39+ -> IO (Maybe Benchmark)
40+readerBench doc name = do
41+ let (rdr, rexts) = either (error . show) id . runPure $ getReader name
42+ res <- runIO $ do
4843 (wtr, wexts) <- getWriter name
4944 case (rdr, wtr) of
5045 (TextReader r, TextWriter w) -> do
51− setResourcePath ["../test"]
46+ setResourcePath ["./test"]
5247 inp <- w def{ writerWrapText = WrapAuto
5348 , writerExtensions = wexts } doc
54− return $ (r def{ readerExtensions = rexts }, inp)
55− _ -> throwError $ PandocSomeError $ "not a text format: "
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: "
5659 <> 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
5766
5867getImages :: IO [(FilePath, MimeType, BL.ByteString)]
5968getImages = do
@@ -89,22 +98,23 @@ main :: IO ()
8998main = do
9099 args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs
91100 print args
92− let matchReader (n, TextReader _) =
101+ let matchReader (n, _) =
93102 null args || ("reader" `elem` args && n `elem` args)
94− matchReader _ = False
95− let matchWriter (n, TextWriter _) =
103+ matchWriter (n, TextWriter _) =
96104 null args || ("writer" `elem` args && n `elem` args)
97105 matchWriter _ = False
98− let matchedReaders = map fst $ (filter matchReader readers
106+ allWriters = map fst (writers :: [(T.Text, Writer PandocPure)])
107+ matchedReaders = map fst (filter matchReader readers
99108 :: [(T.Text, Reader PandocPure)])
100− let matchedWriters = map fst $ (filter matchWriter writers
109+ matchedWriters = map fst (filter matchWriter writers
101110 :: [(T.Text, Writer PandocPure)])
102111 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
103112 let opts = def
104113 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
105− let readerBs = mapMaybe (readerBench doc)
106− $ filter (/="haddock")
107− (matchedReaders `intersect` matchedWriters)
114+ readerBs <- fmap catMaybes
115+ $ mapM (readerBench doc)
116+ $ filter (/="haddock")
117+ (matchedReaders `intersect` allWriters)
108118 -- we need the corresponding writer to generate
109119 -- input for the reader
110120 let writerBs = mapMaybe (writerBench doc) matchedWriters