1 files changed, 101 insertions, 0 deletions
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
new file mode 100644
index 000000000..46ebd77bd
--- /dev/null
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Tests.Writers.Powerpoint (tests) where
+
+import Control.Exception (throwIO)
+import Text.Pandoc
+import Text.Pandoc.Builder
+import Test.Tasty
+import Test.Tasty.HUnit
+import Codec.Archive.Zip
+import Data.List (isPrefixOf, isSuffixOf)
+
+----- Number of Slides -----------
+
+numberOfSlides :: WriterOptions -> Pandoc -> IO Int
+numberOfSlides opts pd = do
+  mbs <- runIO $
+        do setUserDataDir $ Just "../data"
+           writePowerpoint opts pd
+  case mbs of
+       Left e   -> throwIO e
+       Right bs -> do
+         let archive = toArchive 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 $ do
+    n' <- numberOfSlides opts pd
+    n' @=? n
+
+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 "lalune.jpg" "" "") <>
+      para "foo")
+  , testNumberOfSlides
+    "With image slide, header" 3
+    def
+    (doc $
+      para "first slide" <>
+      header 2 "image header" <>
+      (para $ image "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]