benchmark/benchmark-pandoc.hs · typeable/pandoc

git.iko.soy/typeable/pandoc

on 2.5 help sign in

typeable/pandoc/benchmark/benchmark-pandoc.hs

93 lines 3.7 kB history raw

1{-# LANGUAGE NoImplicitPrelude #-}

2{-# LANGUAGE TupleSections #-}

3{-

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.Error (PandocError(..))

23import Control.Monad.Except (throwError)

24import qualified Text.Pandoc.UTF8 as UTF8

25import qualified Data.ByteString as B

26import Criterion.Main

27import Criterion.Types (Config(..))

28import Data.List (intersect)

29import Data.Maybe (mapMaybe)

30import System.Environment (getArgs)

32readerBench :: Pandoc

33 -> String

34 -> Maybe Benchmark

35readerBench doc name =

36 case res of

37 Right (readerFun, inp) ->

38 Just $ bench (name ++ " reader")

39 $ nf (\i -> either (error . show) id $ runPure (readerFun i))

40 inp

41 Left _ -> Nothing

42 where res = runPure $

43 case (getReader name, getWriter name) of

44 (Right (TextReader r, rexts),

45 Right (TextWriter w, wexts)) -> do

46 inp <- w def{ writerWrapText = WrapAuto

47 , writerExtensions = wexts } doc

48 return $ (r def{ readerExtensions = rexts }, inp)

49 _ -> throwError $ PandocSomeError

50 $ "could not get text reader and writer for " ++ name

52writerBench :: Pandoc

53 -> String

54 -> Maybe Benchmark

55writerBench doc name =

56 case res of

57 Right writerFun ->

58 Just $ bench (name ++ " writer")

59 $ nf (\d -> either (error . show) id $

60 runPure (writerFun d)) doc

61 Left _ -> Nothing

62 where res = runPure $ do

63 case (getWriter name) of

64 Right (TextWriter w, wexts) ->

65 return $ w def{ writerExtensions = wexts }

66 _ -> throwError $ PandocSomeError

67 $ "could not get text reader and writer for " ++ name

69main :: IO ()

70main = do

71 args <- filter (\x -> take 1 x /= "-") <$> getArgs

72 print args

73 let matchReader (n, TextReader _) =

74 null args || ("reader" `elem` args && n `elem` args)

75 matchReader _ = False

76 let matchWriter (n, TextWriter _) =

77 null args || ("writer" `elem` args && n `elem` args)

78 matchWriter _ = False

79 let matchedReaders = map fst $ (filter matchReader readers

80 :: [(String, Reader PandocPure)])

81 let matchedWriters = map fst $ (filter matchWriter writers

82 :: [(String, Writer PandocPure)])

83 inp <- UTF8.toText <$> B.readFile "test/testsuite.txt"

84 let opts = def

85 let doc = either (error . show) id $ runPure $ readMarkdown opts inp

86 let readerBs = mapMaybe (readerBench doc)

87 $ filter (/="haddock")

88 (matchedReaders `intersect` matchedWriters)

89 -- we need the corresponding writer to generate

90 -- input for the reader

91 let writerBs = mapMaybe (writerBench doc) matchedWriters

92 defaultMainWith defaultConfig{ timeLimit = 6.0 }

93 (writerBs ++ readerBs)