benchmark/benchmark-pandoc.hs · typeable/pandoc

git.iko.soy/typeable/pandoc

on 2.1 help sign in

typeable/pandoc/benchmark/benchmark-pandoc.hs

86 lines 3.4 kB history raw

1{-# LANGUAGE TupleSections #-}

2{-

5This program is free software; you can redistribute it and/or modify

6it under the terms of the GNU General Public License as published by

7the Free Software Foundation; either version 2 of the License, or

8(at your option) any later version.

10This program is distributed in the hope that it will be useful,

11but WITHOUT ANY WARRANTY; without even the implied warranty of

12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13GNU General Public License for more details.

15You should have received a copy of the GNU General Public License

16along with this program; if not, write to the Free Software

17Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18-}

19import Text.Pandoc

20import qualified Text.Pandoc.UTF8 as UTF8

21import qualified Data.ByteString as B

22import Criterion.Main

23import Criterion.Types (Config(..))

24import Data.List (intersect)

25import Data.Maybe (mapMaybe)

26import System.Environment (getArgs)

28readerBench :: Pandoc

29 -> String

30 -> Maybe Benchmark

31readerBench doc name =

32 case res of

33 Right (readerFun, inp) ->

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

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

36 inp

37 Left _ -> Nothing

38 where res = runPure $ do

39 (TextReader r, rexts)

40 <- either (fail . show) return $ getReader name

41 (TextWriter w, wexts)

42 <- either (fail . show) return $ getWriter name

43 inp <- w def{ writerWrapText = WrapAuto, writerExtensions = wexts }

44 doc

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

47writerBench :: Pandoc

48 -> String

49 -> Maybe Benchmark

50writerBench doc name =

51 case res of

52 Right writerFun ->

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

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

55 runPure (writerFun d)) doc

56 _ -> Nothing

57 where res = runPure $ do

58 (TextWriter w, wexts)

59 <- either (fail . show) return $ getWriter name

60 return $ w def{ writerExtensions = wexts }

62main :: IO ()

63main = do

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

65 print args

66 let matchReader (n, TextReader _) =

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

68 matchReader _ = False

69 let matchWriter (n, TextWriter _) =

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

71 matchWriter _ = False

72 let matchedReaders = map fst $ (filter matchReader readers

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

74 let matchedWriters = map fst $ (filter matchWriter writers

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

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

77 let opts = def

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

79 let readerBs = mapMaybe (readerBench doc)

80 $ filter (/="haddock")

81 (matchedReaders `intersect` matchedWriters)

82 -- we need the corresponding writer to generate

83 -- input for the reader

84 let writerBs = mapMaybe (writerBench doc) matchedWriters

85 defaultMainWith defaultConfig{ timeLimit = 6.0 }

86 (writerBs ++ readerBs)