Added weigh-pandoc for memory usage diagnostics.

See #3169.

2 files changed, 57 insertions, 0 deletions

diff --git a/benchmark/weigh-pandoc.hs b/benchmark/weigh-pandoc.hs
new file mode 100644
index 000000000..198d09b46
--- /dev/null
+++ b/benchmark/weigh-pandoc.hs
@@ -0,0 +1,37 @@
+import Weigh
+import Text.Pandoc
+
+main :: IO ()
+main = do
+  doc <- read <$> readFile "tests/testsuite.native"
+  mainWith $ do
+    func "Pandoc document" id doc
+    mapM_
+      (\(n,r) -> weighReader doc n (handleError . r def{ readerSmart = True }))
+      [("markdown", readMarkdown)
+      ,("html", readHtml)
+      ,("docbook", readDocBook)
+      ,("latex", readLaTeX)
+      ,("commonmark", readCommonMark)
+      ]
+    mapM_
+      (\(n,w) -> weighWriter doc n (w def))
+      [("markdown", writeMarkdown)
+      ,("html", writeHtmlString)
+      ,("docbook", writeDocbook)
+      ,("latex", writeLaTeX)
+      ,("commonmark", writeCommonMark)
+      ]
+
+weighWriter :: Pandoc -> String -> (Pandoc -> String) -> Weigh ()
+weighWriter doc name writer = func (name ++ " writer") writer doc
+
+weighReader :: Pandoc -> String -> (String -> Pandoc) -> Weigh ()
+weighReader doc name reader = do
+  case lookup name writers of
+       Just (PureStringWriter writer) ->
+         let inp = writer def{ writerWrapText = WrapAuto} doc
+         in func (name ++ " reader") reader inp
+       _ -> return () -- no writer for reader
+
+
diff --git a/pandoc.cabal b/pandoc.cabal
index 368ce5c1d..05e9c4157 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -236,6 +236,10 @@ Flag trypandoc
   Description:   Build trypandoc cgi executable.
   Default:       False
 
+Flag weigh-pandoc
+  Description:   Build weigh-pandoc to measure memory usage.
+  Default:       False
+
 Flag https
   Description:   Enable support for downloading of resources over https.
   Default:       True
@@ -472,6 +476,22 @@ Executable trypandoc
   else
     Buildable:     False
 
+Executable weigh-pandoc
+  Main-Is:         weigh-pandoc.hs
+  Hs-Source-Dirs:  benchmark
+  if impl(ghc < 7.10)
+     Hs-Source-Dirs: prelude
+     Other-Modules:  Prelude
+  if flag(weigh-pandoc)
+     Build-Depends:   pandoc,
+                      base >= 4.2 && < 5,
+                      weigh >= 0.0 && < 0.1
+     Buildable:       True
+  else
+    Buildable:     False
+  Ghc-Options:   -rtsopts -Wall -fno-warn-unused-do-bind
+  Default-Language: Haskell98
+
 Test-Suite test-pandoc
   Type:           exitcode-stdio-1.0
   Main-Is:        test-pandoc.hs