benchmark/benchmark-pandoc.hs · typeable/pandoc

git.iko.soy/typeable/pandoc

on 2.2.2 help sign in

typeable/pandoc/benchmark/benchmark-pandoc.hs

88 lines 3.4 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 qualified Text.Pandoc.UTF8 as UTF8

23import qualified Data.ByteString as B

24import Criterion.Main

25import Criterion.Types (Config(..))

26import Data.List (intersect)

27import Data.Maybe (mapMaybe)

28import System.Environment (getArgs)

30readerBench :: Pandoc

31 -> String

32 -> Maybe Benchmark

33readerBench doc name =

34 case res of

35 Right (readerFun, inp) ->

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

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

38 inp

39 Left _ -> Nothing

40 where res = runPure $ do

41 (TextReader r, rexts)

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

43 (TextWriter w, wexts)

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

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

46 doc

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

49writerBench :: Pandoc

50 -> String

51 -> Maybe Benchmark

52writerBench doc name =

53 case res of

54 Right writerFun ->

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

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

57 runPure (writerFun d)) doc

58 _ -> Nothing

59 where res = runPure $ do

60 (TextWriter w, wexts)

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

62 return $ w def{ writerExtensions = wexts }

64main :: IO ()

65main = do

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

67 print args

68 let matchReader (n, TextReader _) =

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

70 matchReader _ = False

71 let matchWriter (n, TextWriter _) =

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

73 matchWriter _ = False

74 let matchedReaders = map fst $ (filter matchReader readers

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

76 let matchedWriters = map fst $ (filter matchWriter writers

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

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

79 let opts = def

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

81 let readerBs = mapMaybe (readerBench doc)

82 $ filter (/="haddock")

83 (matchedReaders `intersect` matchedWriters)

84 -- we need the corresponding writer to generate

85 -- input for the reader

86 let writerBs = mapMaybe (writerBench doc) matchedWriters

87 defaultMainWith defaultConfig{ timeLimit = 6.0 }

88 (writerBs ++ readerBs)