PowerPoint writer: Introduce beginning of tests

This is the beginning of a test suite for the powerpoint
writer. Initial tests are for the number of slides.

Note that at the moment it does not test against corruption in
Microsoft PowerPoint; it just tests that certain outcomes work as
expected. More tests will be added.

This test framework uses the PandocPure monad introduced with Pandoc 2.0.

1 files changed, 115 insertions, 0 deletions

diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
new file mode 100644
index 000000000..82791adac
--- /dev/null
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Tests.Writers.Powerpoint (tests) where
+
+import Text.Pandoc.Writers.Powerpoint (writePowerpoint)
+import Text.Pandoc
+import Text.Pandoc.Builder
+-- import Text.Pandoc.Error (PandocError(..))
+import Test.Tasty
+import Test.Tasty.HUnit
+import Codec.Archive.Zip
+import Text.Pandoc.Class (runPure)
+import Tests.Writers.Powerpoint.PureData (pureFileTree)
+import Data.List (isPrefixOf, isSuffixOf)
+
+data PowerpointTestError = ErrorFromPandoc PandocError
+                         | ErrorFromZipArchive String
+                         deriving (Show)
+
+fromPandoc :: Either PandocError a -> Either PowerpointTestError a
+fromPandoc x = case x of
+  Right r -> Right r
+  Left e -> Left $ ErrorFromPandoc e
+
+fromZipArchive :: Either String a -> Either PowerpointTestError a
+fromZipArchive x = case x of
+  Right r -> Right r
+  Left s -> Left $ ErrorFromZipArchive s
+
+----- Number of Slides -----------
+
+numberOfSlides :: WriterOptions -> Pandoc -> Either PowerpointTestError Int
+numberOfSlides opts pd = do
+  bs <- fromPandoc $ runPure $
+        do modifyPureState (\st -> st {stFiles = pureFileTree})
+           writePowerpoint opts pd
+  archive <- fromZipArchive $ toArchiveOrFail bs
+  return $
+    length $
+    filter (isSuffixOf ".xml") $
+    filter (isPrefixOf "ppt/slides/slide") $
+    filesInArchive archive
+
+testNumberOfSlides :: TestName -> Int -> WriterOptions -> Pandoc -> TestTree
+testNumberOfSlides name n opts pd =
+  testCase name $ case numberOfSlides opts pd of
+                    Right n' -> n' @=? n
+                    Left e -> assertBool (show e) False
+
+numSlideTests :: TestTree
+numSlideTests = testGroup "Number of slides in output"
+  [ testNumberOfSlides
+    "simple one-slide deck" 1
+    def
+    (doc $ para "foo")
+  , testNumberOfSlides
+    "with metadata (header slide)" 2
+    def
+    (setTitle "My Title" $ doc $ para "foo")
+  , testNumberOfSlides
+    "With h1 slide (using default slide-level)" 2
+    def
+    (doc $ header 1 "Header" <> para "foo")
+  , testNumberOfSlides
+    "With h2 slide (using default slide-level)" 2
+    def
+    (doc $ header 1 "Header" <> header 2 "subeader" <> para "foo")
+  , testNumberOfSlides
+    "With h1 slide (using default slide-level)" 2
+    def
+    (doc $ header 1 "Header" <> para "foo")
+  , testNumberOfSlides
+    "With h2 slide (using default slide-level)" 2
+    def
+    (doc $ header 1 "Header" <> header 2 "subeader" <> para "foo")
+  , testNumberOfSlides
+    "With image slide, no header" 3
+    def
+    (doc $
+      para "first slide" <>
+      (para $ image "/fakefs/img/lalune.jpg" "" "") <>
+      para "foo")
+  , testNumberOfSlides
+    "With image slide, header" 3
+    def
+    (doc $
+      para "first slide" <>
+      header 2 "image header" <>
+      (para $ image "/fakefs/img/lalune.jpg" "" "") <>
+      para "foo")
+  , testNumberOfSlides
+    "With table, no header" 3
+    def
+    (doc $
+     para "first slide" <>
+     (simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]]) <>
+     para "foo")
+  , testNumberOfSlides
+    "With table, header" 3
+    def
+    (doc $
+     para "first slide" <>
+     header 2 "table header" <>
+     (simpleTable [para "foo" <> para "bar"] [[para "this" <> para "that"]]) <>
+     para "foo")
+  , testNumberOfSlides
+    "hrule" 2
+    def
+    (doc $
+     para "first slide" <> horizontalRule <> para "last slide")
+  ]
+
+
+tests :: [TestTree]
+tests = [numSlideTests]