@@ -18,48 +18,37 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
1818-}
1919import Text.Pandoc
2020import Text.Pandoc.MIME
21−import Control.Monad.Except (throwError, liftIO)
21+import Control.Monad.Except (throwError)
2222import qualified Text.Pandoc.UTF8 as UTF8
2323import qualified Data.ByteString as B
2424import qualified Data.Text as T
2525import Test.Tasty.Bench
26−import Data.List (intersect)
27−import Data.Maybe (mapMaybe, catMaybes)
28−import System.Environment (getArgs)
2926import qualified Data.ByteString.Lazy as BL
30−
31−data Input = InputText {unInputText :: T.Text}
32− | InputBS {unInputBS :: BL.ByteString}
27+import Data.Maybe (mapMaybe)
3328
3429readerBench :: Pandoc
3530 -> T.Text
36− -> IO (Maybe Benchmark)
37−readerBench doc name = do
38− let (rdr, rexts) = either (error . show) id . runPure $ getReader name
39− res <- runIO $ do
40− (wtr, wexts) <- getWriter name
41− case (rdr, wtr) of
42− (TextReader r, TextWriter w) -> do
43− setResourcePath ["./test"]
44− inp <- w def{ writerWrapText = WrapAuto
45− , writerExtensions = wexts } doc
46− return (r def{ readerExtensions = rexts } . unInputText, InputText inp)
47− (ByteStringReader r, ByteStringWriter w) -> do
48− setResourcePath ["./test"]
49− tmpl <- Just <$> compileDefaultTemplate name
50− inp <- w def{ writerWrapText = WrapAuto
51− , writerExtensions = wexts
52− , writerTemplate = tmpl } doc
53− liftIO $ BL.writeFile "/tmp/test.odt" inp
54− return (r def{ readerExtensions = rexts } . unInputBS, InputBS inp)
55− _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "
56− <> name
57− return $ case res of
58− Right (readerFun, inp) ->
59− Just $ bench (T.unpack name)
60− $ nf (\i -> either (error . show) id $ runPure (readerFun i))
61− inp
62− Left _ -> Nothing
31+ -> Maybe Benchmark
32+readerBench doc name = either (const Nothing) Just $
33+ runPure $ do
34+ (rdr, rexts) <- getReader name
35+ (wtr, wexts) <- getWriter name
36+ case (rdr, wtr) of
37+ (TextReader r, TextWriter w) -> do
38+ inp <- w def{ writerWrapText = WrapAuto
39+ , writerExtensions = wexts } doc
40+ return $ bench (T.unpack name) $
41+ nf (either (error . show) id . runPure . r def) inp
42+ (ByteStringReader r, ByteStringWriter w) -> do
43+ tmpl <- Just <$> compileDefaultTemplate name
44+ inp <- w def{ writerWrapText = WrapAuto
45+ , writerExtensions = wexts
46+ , writerTemplate = tmpl } doc
47+ return $ bench (T.unpack name) $
48+ nf (either (error . show) id .
49+ runPure . r def{readerExtensions = rexts}) inp
50+ _ -> throwError $ PandocSomeError $ "text/bytestring format mismatch: "
51+ <> name
6352
6453getImages :: IO [(FilePath, MimeType, BL.ByteString)]
6554getImages = do
@@ -72,51 +61,29 @@ writerBench :: [(FilePath, MimeType, BL.ByteString)]
7261 -> Pandoc
7362 -> T.Text
7463 -> Maybe Benchmark
75−writerBench imgs doc name =
76− case res of
77− Right writerFun ->
78− Just $ bench (T.unpack name)
64+writerBench imgs doc name = either (const Nothing) Just $
65+ runPure $ do
66+ (wtr, wexts) <- getWriter name
67+ case wtr of
68+ TextWriter writerFun ->
69+ return $ bench (T.unpack name)
7970 $ nf (\d -> either (error . show) id $
80− runPure (do mapM_
81− (\(fp, mt, bs) ->
82− insertMedia fp (Just mt) bs)
83− imgs
84− writerFun d)) doc
85− Left _ -> Nothing
86− where res = runPure $ do
87− (wtr, wexts) <- getWriter name
88− case wtr of
89− TextWriter w ->
90− return $ w def{ writerExtensions = wexts }
91− _ -> throwError $ PandocSomeError
92− $ "could not get text writer for " <> name
71+ runPure $ do
72+ mapM_ (\(fp,mt,bs) -> insertMedia fp (Just mt) bs) imgs
73+ writerFun def{ writerExtensions = wexts} d)
74+ doc
75+ _ -> throwError $ PandocSomeError
76+ $ "could not get text writer for " <> name
9377
9478main :: IO ()
9579main = do
96− args <- filter (\x -> T.take 1 x /= "-") . fmap T.pack <$> getArgs
97− print args
98− let matchReader (n, _) =
99− null args || ("reader" `elem` args && n `elem` args)
100− matchWriter (n, TextWriter _) =
101− null args || ("writer" `elem` args && n `elem` args)
102− matchWriter _ = False
103− allWriters = map fst (writers :: [(T.Text, Writer PandocPure)])
104− matchedReaders = map fst (filter matchReader readers
105− :: [(T.Text, Reader PandocPure)])
106− matchedWriters = map fst (filter matchWriter writers
107− :: [(T.Text, Writer PandocPure)])
10880 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"
10981 let opts = def
11082 let doc = either (error . show) id $ runPure $ readMarkdown opts inp
111− readerBs <- fmap catMaybes
112− $ mapM (readerBench doc)
113− $ filter (/="haddock")
114− (matchedReaders `intersect` allWriters)
115− -- we need the corresponding writer to generate
116− -- input for the reader
11783 imgs <- getImages
118− let writerBs = mapMaybe (writerBench imgs doc) matchedWriters
11984 defaultMain
120− [ bgroup "writers" writerBs
121− , bgroup "readers" readerBs
85+ [ bgroup "writers" $ mapMaybe (writerBench imgs doc . fst)
86+ (writers :: [(T.Text, Writer PandocPure)])
87+ , bgroup "readers" $ mapMaybe (readerBench doc . fst)
88+ (readers :: [(T.Text, Reader PandocPure)])
12289 ]