pptx: Support footers in the reference doc

In PowerPoint, it’s possible to specify footers across all slides,
containing a date (optionally automatically updated to today’s date),
the slide number (optionally starting from a higher number than 1), and
static text. There’s also an option to hide the footer on the title
slide.

Before this commit, none of that footer content was pulled through from
the reference doc: this commit supports all the functionality listed
above.

There is one behaviour which may not be immediately obvious: if the
reference doc specifies a fixed date (i.e. not automatically updating),
and there’s a date specified in the metadata for the document, the
footer date is replaced by the metadata date.

- Include date, slide number, and static footer content from reference
  doc
- Respect “slide number starts from” option
- Respect “Don’t show on title slide” option
- Add tests

12 files changed, 372 insertions, 199 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index 0c8cf0d61..4881fe3a4 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -414,6 +414,11 @@ extra-source-files:
                  test/pptx/endnotes-toc/*.pptx
                  test/pptx/endnotes/input.native
                  test/pptx/endnotes/*.pptx
+                 test/pptx/footer/input.native
+                 test/pptx/footer/basic/*.pptx
+                 test/pptx/footer/fixed-date/*.pptx
+                 test/pptx/footer/higher-slide-number/*.pptx
+                 test/pptx/footer/no-title-slide/*.pptx
                  test/pptx/images/input.native
                  test/pptx/images/*.pptx
                  test/pptx/incremental-lists/with-flag/input.native
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 1431469d3..acfd446de 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
 {- |
@@ -159,7 +160,7 @@ data SlideLayoutsOf a = SlideLayouts
   , comparison :: a
   , contentWithCaption :: a
   , blank :: a
-  } deriving (Show, Functor, Foldable, Traversable)
+  } deriving (Show, Eq, Functor, Foldable, Traversable)
 
 data SlideLayout = SlideLayout
   { slElement :: Element
@@ -197,12 +198,14 @@ data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int LinkTarget)
                                -- (FP, Local ID, Global ID, Maybe Mime)
                                , stMediaIds :: M.Map Int [MediaInfo]
                                , stMediaGlobalIds :: M.Map FilePath Int
+                               , stFooterInfo :: Maybe FooterInfo
                                } deriving (Show, Eq)
 
 instance Default WriterState where
   def = WriterState { stLinkIds = mempty
                     , stMediaIds = mempty
                     , stMediaGlobalIds = mempty
+                    , stFooterInfo = Nothing
                     }
 
 type P m = ReaderT WriterEnv (StateT WriterState m)
@@ -316,8 +319,14 @@ presentationToArchiveP p@(Presentation docProps slides) = do
         else id
   let newArch' = foldr f newArch slideLayouts
 
-  -- Update the master to make sure it includes any layouts we've just added
   master <- getMaster
+  refArchive <- asks envRefArchive
+  distArchive <- asks envDistArchive
+  presentationElement <- parseXml refArchive distArchive "ppt/presentation.xml"
+  modify (\s -> s {stFooterInfo =
+                   getFooterInfo slideLayouts master presentationElement})
+
+  -- Update the master to make sure it includes any layouts we've just added
   masterRels <- getMasterRels
   let (updatedMasterElem, updatedMasterRelElem) = updateMasterElems slideLayouts master masterRels
   updatedMasterEntry <- elemToEntry "ppt/slideMasters/slideMaster1.xml" updatedMasterElem
@@ -432,6 +441,56 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
         getIdAttribute (Elem e) = findAttr (QName "id" Nothing Nothing) e
         getIdAttribute _ = Nothing
 
+data FooterInfo = FooterInfo
+  { fiDate :: SlideLayoutsOf (Maybe Element)
+  , fiFooter :: SlideLayoutsOf (Maybe Element)
+  , fiSlideNumber :: SlideLayoutsOf (Maybe Element)
+  , fiShowOnFirstSlide :: Bool
+  } deriving (Show, Eq)
+
+getFooterInfo :: SlideLayouts -> Element -> Element -> Maybe FooterInfo
+getFooterInfo layouts master presentation = do
+  let ns = elemToNameSpaces master
+  hf <- findChild (elemName ns "p" "hf") master
+  let fiDate = getShape "dt" hf . slElement <$> layouts
+      fiFooter = getShape "ftr" hf . slElement <$> layouts
+      fiSlideNumber = getShape "sldNum" hf . slElement <$> layouts
+      fiShowOnFirstSlide =
+        fromMaybe True
+        (getBooleanAttribute "showSpecialPlsOnTitleSld" presentation)
+  pure FooterInfo{..}
+    where
+      getShape t hf layout =
+        if fromMaybe True (getBooleanAttribute t hf)
+        then do
+          let ns = elemToNameSpaces layout
+          cSld <- findChild (elemName ns "p" "cSld") layout
+          spTree <- findChild (elemName ns "p" "spTree") cSld
+          let containsPlaceholder sp = fromMaybe False $ do
+                nvSpPr <- findChild (elemName ns "p" "nvSpPr") sp
+                nvPr <- findChild (elemName ns "p" "nvPr") nvSpPr
+                ph <- findChild (elemName ns "p" "ph") nvPr
+                placeholderType <- findAttr (QName "type" Nothing Nothing) ph
+                pure (placeholderType == t)
+          listToMaybe (filterChildren containsPlaceholder spTree)
+        else Nothing
+
+      getBooleanAttribute t e =
+        (`elem` ["1", "true"]) <$>
+          (findAttr (QName t Nothing Nothing) e)
+
+footerElements ::
+  PandocMonad m =>
+  (forall a. SlideLayoutsOf a -> a) ->
+  P m [Content]
+footerElements layout = do
+  footerInfo <- gets stFooterInfo
+  pure
+    $ Elem <$>
+      (toList (footerInfo >>= layout . fiDate)
+       <> toList (footerInfo >>= layout . fiFooter)
+       <> toList (footerInfo >>= layout . fiSlideNumber))
+
 makeSlideIdMap :: Presentation -> M.Map SlideId Int
 makeSlideIdMap (Presentation _ slides) =
   M.fromList $ map slideId slides `zip` [1..]
@@ -1372,13 +1431,14 @@ contentToElement layout hdrShape shapes
       (shapeId, element) <- nonBodyTextToElement layout [PHType "title"] hdrShape
       let hdrShapeElements = [Elem element | not (null hdrShape)]
           contentHeaderId = if null hdrShape then Nothing else shapeId
-      content <- local
+      content' <- local
                          (\env -> env {envPlaceholder = Placeholder ObjType 0})
                          (shapesToElements layout shapes)
-      let contentContentIds = mapMaybe fst content
-          contentElements = snd <$> content
+      let contentContentIds = mapMaybe fst content'
+          contentElements = snd <$> content'
+      footer <- footerElements content
       return ( Just ContentShapeIds{..}
-             , buildSpTree ns spTree (hdrShapeElements <> contentElements)
+             , buildSpTree ns spTree (hdrShapeElements <> contentElements <> footer)
              )
 contentToElement _ _ _ = return (Nothing, mknode "p:sp" [] ())
 
@@ -1412,10 +1472,11 @@ twoColumnToElement layout hdrShape shapesL shapesR
           contentElementsR = snd <$> contentR
       -- let contentElementsL' = map (setIdx ns "1") contentElementsL
       --     contentElementsR' = map (setIdx ns "2") contentElementsR
+      footer <- footerElements twoColumn
       return
         $ (Just TwoColumnShapeIds{..}, )
         $ buildSpTree ns spTree
-        $ hdrShapeElements <> contentElementsL <> contentElementsR
+        $ hdrShapeElements <> contentElementsL <> contentElementsR <> footer
 twoColumnToElement _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
 
 data ComparisonShapeIds = ComparisonShapeIds
@@ -1456,6 +1517,7 @@ comparisonToElement layout hdrShape (shapesL1, shapesL2) (shapesR1, shapesR2)
                          (shapesToElements layout shapesR2)
       let comparisonRightContentIds = mapMaybe fst contentR2
           contentElementsR2 = snd <$> contentR2
+      footer <- footerElements comparison
       return
         $ (Just ComparisonShapeIds{..}, )
         $ buildSpTree ns spTree
@@ -1464,7 +1526,7 @@ comparisonToElement layout hdrShape (shapesL1, shapesL2) (shapesR1, shapesR2)
                   , contentElementsL2
                   , contentElementsR1
                   , contentElementsR2
-                  ]
+                  ] <> footer
 comparisonToElement _ _ _ _= return (Nothing, mknode "p:sp" [] ())
 
 data ContentWithCaptionShapeIds = ContentWithCaptionShapeIds
@@ -1495,13 +1557,14 @@ contentWithCaptionToElement layout hdrShape textShapes contentShapes
                        (shapesToElements layout contentShapes)
       let contentWithCaptionContentIds = mapMaybe fst content
           contentElements = snd <$> content
+      footer <- footerElements contentWithCaption
       return
         $ (Just ContentWithCaptionShapeIds{..}, )
         $ buildSpTree ns spTree
         $ mconcat [ hdrShapeElements
                   , textElements
                   , contentElements
-                  ]
+                  ] <> footer
 contentWithCaptionToElement _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
 
 blankToElement ::
@@ -1511,8 +1574,8 @@ blankToElement ::
 blankToElement layout
   | ns <- elemToNameSpaces layout
   , Just cSld <- findChild (elemName ns "p" "cSld") layout
-  , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
-      return $ buildSpTree ns spTree []
+  , Just spTree <- findChild (elemName ns "p" "spTree") cSld =
+      buildSpTree ns spTree <$> footerElements blank
 blankToElement _ = return $ mknode "p:sp" [] ()
 
 newtype TitleShapeIds = TitleShapeIds
@@ -1531,7 +1594,10 @@ titleToElement layout titleElems
       (shapeId, element) <- nonBodyTextToElement layout [PHType "title", PHType "ctrTitle"] titleElems
       let titleShapeElements = [Elem element | not (null titleElems)]
           titleHeaderId = if null titleElems then Nothing else shapeId
-      return $ (Just TitleShapeIds{..}, ) $ buildSpTree ns spTree titleShapeElements
+      footer <- footerElements title
+      return
+        $ (Just TitleShapeIds{..}, )
+        $ buildSpTree ns spTree (titleShapeElements <> footer)
 titleToElement _ _ = return (Nothing, mknode "p:sp" [] ())
 
 data MetadataShapeIds = MetadataShapeIds
@@ -1561,13 +1627,20 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
           metadataTitleId = if null titleElems then Nothing else titleId
           subtitleShapeElements = [subtitleElement | not (null subtitleAndAuthorElems)]
           metadataSubtitleId = if null subtitleAndAuthorElems then Nothing else subtitleId
-          dateShapeElements = [dateElement | not (null dateElems)]
+      footerInfo <- gets stFooterInfo
+      footer <- (if maybe False fiShowOnFirstSlide footerInfo
+                 then id
+                 else const []) <$> footerElements metadata
+      let dateShapeElements = [dateElement
+                              | not (null dateElems
+                                || isJust (footerInfo >>= metadata . fiDate))
+                              ]
           metadataDateId = if null dateElems then Nothing else dateId
       return
         $ (Just MetadataShapeIds{..}, )
         $ buildSpTree ns spTree
-        $ map Elem
-        $ titleShapeElements <> subtitleShapeElements <> dateShapeElements
+        $ map Elem (titleShapeElements <> subtitleShapeElements <> dateShapeElements)
+        <> footer
 metadataToElement _ _ _ _ _ = return (Nothing, mknode "p:sp" [] ())
 
 slideToElement :: PandocMonad m => Slide -> P m Element
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index 6e676dc37..b2df80e5f 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -61,187 +61,216 @@ groupPptxTests pairs =
 
 
 tests :: [TestTree]
-tests = groupPptxTests [ pptxTests "Inline formatting"
-                         def
-                         "pptx/inline-formatting/input.native"
-                         "pptx/inline-formatting/output.pptx"
-                       , pptxTests "Slide breaks (default slide-level)"
-                         def
-                         "pptx/slide-breaks/input.native"
-                         "pptx/slide-breaks/output.pptx"
-                       , pptxTests "slide breaks (slide-level set to 1)"
-                         def{ writerSlideLevel = Just 1 }
-                         "pptx/slide-breaks/input.native"
-                         "pptx/slide-breaks-slide-level-1/output.pptx"
-                       , pptxTests "lists"
-                         def
-                         "pptx/lists/input.native"
-                         "pptx/lists/output.pptx"
-                       , pptxTests "start ordered list at specified num"
-                         def
-                         "pptx/start-numbering-at/input.native"
-                         "pptx/start-numbering-at/output.pptx"
-                       , pptxTests "tables"
-                         def
-                         "pptx/tables/input.native"
-                         "pptx/tables/output.pptx"
-                       , pptxTests "table of contents"
-                         def{ writerTableOfContents = True }
-                         "pptx/slide-breaks/input.native"
-                         "pptx/slide-breaks-toc/output.pptx"
-                       , pptxTests "end notes"
-                         def
-                         "pptx/endnotes/input.native"
-                         "pptx/endnotes/output.pptx"
-                       , pptxTests "end notes, with table of contents"
-                         def { writerTableOfContents = True }
-                         "pptx/endnotes/input.native"
-                         "pptx/endnotes-toc/output.pptx"
-                       , pptxTests "images"
-                         def
-                         "pptx/images/input.native"
-                         "pptx/images/output.pptx"
-                       , pptxTests "two-column layout"
-                         def
-                         "pptx/two-column/all-text/input.native"
-                         "pptx/two-column/all-text/output.pptx"
-                       , pptxTests "two-column (not comparison)"
-                         def
-                         "pptx/two-column/text-and-image/input.native"
-                         "pptx/two-column/text-and-image/output.pptx"
-                       , pptxTests "speaker notes"
-                         def
-                         "pptx/speaker-notes/input.native"
-                         "pptx/speaker-notes/output.pptx"
-                       , pptxTests "speaker notes after a separating block"
-                         def
-                         "pptx/speaker-notes-afterseps/input.native"
-                         "pptx/speaker-notes-afterseps/output.pptx"
-                       , pptxTests "speaker notes after a separating header"
-                         def
-                         "pptx/speaker-notes-afterheader/input.native"
-                         "pptx/speaker-notes-afterheader/output.pptx"
-                       , pptxTests "speaker notes after metadata"
-                         def
-                         "pptx/speaker-notes-after-metadata/input.native"
-                         "pptx/speaker-notes-after-metadata/output.pptx"
-                       , pptxTests "remove empty slides"
-                         def
-                         "pptx/remove-empty-slides/input.native"
-                         "pptx/remove-empty-slides/output.pptx"
-                       , pptxTests "raw ooxml"
-                         def
-                         "pptx/raw-ooxml/input.native"
-                         "pptx/raw-ooxml/output.pptx"
-                       , pptxTests "metadata, custom properties"
-                         def
-                         "pptx/document-properties/input.native"
-                         "pptx/document-properties/output.pptx"
-                       , pptxTests "metadata, short description"
-                         def
-                         "pptx/document-properties-short-desc/input.native"
-                         "pptx/document-properties-short-desc/output.pptx"
-                       , pptxTests "inline code and code blocks"
-                         def
-                         "pptx/code/input.native"
-                         "pptx/code/output.pptx"
-                       , pptxTests "inline code and code blocks, custom formatting"
-                         def { writerVariables = Context $ M.fromList
-                                 [(pack "monofont", toVal $ pack "Consolas")] }
-                         "pptx/code/input.native"
-                         "pptx/code-custom/output.pptx"
-                       , pptxTests ("Using slide level 0, if the first thing on "
-                                    <> "a slide is a h1 it's used as the "
-                                    <> "slide title")
-                         def { writerSlideLevel = Just 0 }
-                         "pptx/slide-level-0/h1-with-image/input.native"
-                         "pptx/slide-level-0/h1-with-image/output.pptx"
-                       , pptxTests ("Using slide level 0, if the first thing on "
-                                    <> "a slide is a h2 it's used as the "
-                                    <> "slide title")
-                         def { writerSlideLevel = Just 0 }
-                         "pptx/slide-level-0/h2-with-image/input.native"
-                         "pptx/slide-level-0/h2-with-image/output.pptx"
-                       , pptxTests ("Using slide level 0, if the first thing on "
-                                    <> "a slide is a heading it's used as the "
-                                    <> "slide title (works with a table)")
-                         def { writerSlideLevel = Just 0 }
-                         "pptx/slide-level-0/h1-with-table/input.native"
-                         "pptx/slide-level-0/h1-with-table/output.pptx"
-                       , pptxTests ("Using slide level 0, if the first thing on "
-                                    <> "a slide is a heading it's used as the "
-                                    <> "slide title (content with caption layout)")
-                         def { writerSlideLevel = Just 0 }
-                         "pptx/slide-level-0/h1-h2-with-table/input.native"
-                         "pptx/slide-level-0/h1-h2-with-table/output.pptx"
-                       , pptxTests ("comparison layout used when two columns "
-                                    <> "contain text plus non-text")
-                         def
-                         "pptx/comparison/both-columns/input.native"
-                         "pptx/comparison/both-columns/output.pptx"
-                       , pptxTests ("comparison layout used even when only one "
-                                    <> "column contains text plus non-text")
-                         def
-                         "pptx/comparison/one-column/input.native"
-                         "pptx/comparison/one-column/output.pptx"
-                       , pptxTests ("extra text in one column in comparison "
-                                    <> "layout gets overlaid")
-                         def
-                         "pptx/comparison/extra-text/input.native"
-                         "pptx/comparison/extra-text/output.pptx"
-                       , pptxTests ("extra image in one column in comparison "
-                                   <> "layout gets overlaid")
-                         def
-                         "pptx/comparison/extra-image/input.native"
-                         "pptx/comparison/extra-image/output.pptx"
-                       , pptxTests "comparison not used if the non-text comes first"
-                         def
-                         "pptx/comparison/non-text-first/input.native"
-                         "pptx/comparison/non-text-first/output.pptx"
-                       , pptxTests ("Heading, text and an image on the same "
-                                    <> "slide uses the Content with Caption "
-                                    <> "layout")
-                         def
-                         "pptx/content-with-caption/heading-text-image/input.native"
-                         "pptx/content-with-caption/heading-text-image/output.pptx"
-                       , pptxTests ("Text and an image on the same "
-                                    <> "slide uses the Content with Caption "
-                                    <> "layout")
-                         def
-                         "pptx/content-with-caption/text-image/input.native"
-                         "pptx/content-with-caption/text-image/output.pptx"
-                       , pptxTests ("If the image comes first, Content with "
-                                    <> "Caption is not used")
-                         def
-                         "pptx/content-with-caption/image-text/input.native"
-                         "pptx/content-with-caption/image-text/output.pptx"
-                       , pptxTests ("If a slide contains only speaker notes, the "
-                                    <> "Blank layout is used")
-                         def
-                         "pptx/blanks/just-speaker-notes/input.native"
-                         "pptx/blanks/just-speaker-notes/output.pptx"
-                       , pptxTests ("If a slide contains only an empty heading "
-                                    <> "with a body of only non-breaking spaces"
-                                    <> ", the Blank layout is used")
-                         def
-                         "pptx/blanks/nbsp-in-body/input.native"
-                         "pptx/blanks/nbsp-in-body/output.pptx"
-                       , pptxTests ("If a slide contains only a heading "
-                                    <> "containing only non-breaking spaces, "
-                                    <> "the Blank layout is used")
-                         def
-                         "pptx/blanks/nbsp-in-heading/input.native"
-                         "pptx/blanks/nbsp-in-heading/output.pptx"
-                       , pptxTests ("Incremental lists are supported")
-                         def { writerIncremental = True }
-                         "pptx/incremental-lists/with-flag/input.native"
-                         "pptx/incremental-lists/with-flag/output.pptx"
-                       , pptxTests ("One-off incremental lists are supported")
-                         def
-                         "pptx/incremental-lists/without-flag/input.native"
-                         "pptx/incremental-lists/without-flag/output.pptx"
-                       , pptxTests "Background images"
-                         def
-                         "pptx/background-image/input.native"
-                         "pptx/background-image/output.pptx"
-                       ]
+tests = let
+  regularTests =
+    groupPptxTests [ pptxTests "Inline formatting"
+                     def
+                     "pptx/inline-formatting/input.native"
+                     "pptx/inline-formatting/output.pptx"
+                   , pptxTests "Slide breaks (default slide-level)"
+                     def
+                     "pptx/slide-breaks/input.native"
+                     "pptx/slide-breaks/output.pptx"
+                   , pptxTests "slide breaks (slide-level set to 1)"
+                     def{ writerSlideLevel = Just 1 }
+                     "pptx/slide-breaks/input.native"
+                     "pptx/slide-breaks-slide-level-1/output.pptx"
+                   , pptxTests "lists"
+                     def
+                     "pptx/lists/input.native"
+                     "pptx/lists/output.pptx"
+                   , pptxTests "start ordered list at specified num"
+                     def
+                     "pptx/start-numbering-at/input.native"
+                     "pptx/start-numbering-at/output.pptx"
+                   , pptxTests "tables"
+                     def
+                     "pptx/tables/input.native"
+                     "pptx/tables/output.pptx"
+                   , pptxTests "table of contents"
+                     def{ writerTableOfContents = True }
+                     "pptx/slide-breaks/input.native"
+                     "pptx/slide-breaks-toc/output.pptx"
+                   , pptxTests "end notes"
+                     def
+                     "pptx/endnotes/input.native"
+                     "pptx/endnotes/output.pptx"
+                   , pptxTests "end notes, with table of contents"
+                     def { writerTableOfContents = True }
+                     "pptx/endnotes/input.native"
+                     "pptx/endnotes-toc/output.pptx"
+                   , pptxTests "images"
+                     def
+                     "pptx/images/input.native"
+                     "pptx/images/output.pptx"
+                   , pptxTests "two-column layout"
+                     def
+                     "pptx/two-column/all-text/input.native"
+                     "pptx/two-column/all-text/output.pptx"
+                   , pptxTests "two-column (not comparison)"
+                     def
+                     "pptx/two-column/text-and-image/input.native"
+                     "pptx/two-column/text-and-image/output.pptx"
+                   , pptxTests "speaker notes"
+                     def
+                     "pptx/speaker-notes/input.native"
+                     "pptx/speaker-notes/output.pptx"
+                   , pptxTests "speaker notes after a separating block"
+                     def
+                     "pptx/speaker-notes-afterseps/input.native"
+                     "pptx/speaker-notes-afterseps/output.pptx"
+                   , pptxTests "speaker notes after a separating header"
+                     def
+                     "pptx/speaker-notes-afterheader/input.native"
+                     "pptx/speaker-notes-afterheader/output.pptx"
+                   , pptxTests "speaker notes after metadata"
+                     def
+                     "pptx/speaker-notes-after-metadata/input.native"
+                     "pptx/speaker-notes-after-metadata/output.pptx"
+                   , pptxTests "remove empty slides"
+                     def
+                     "pptx/remove-empty-slides/input.native"
+                     "pptx/remove-empty-slides/output.pptx"
+                   , pptxTests "raw ooxml"
+                     def
+                     "pptx/raw-ooxml/input.native"
+                     "pptx/raw-ooxml/output.pptx"
+                   , pptxTests "metadata, custom properties"
+                     def
+                     "pptx/document-properties/input.native"
+                     "pptx/document-properties/output.pptx"
+                   , pptxTests "metadata, short description"
+                     def
+                     "pptx/document-properties-short-desc/input.native"
+                     "pptx/document-properties-short-desc/output.pptx"
+                   , pptxTests "inline code and code blocks"
+                     def
+                     "pptx/code/input.native"
+                     "pptx/code/output.pptx"
+                   , pptxTests "inline code and code blocks, custom formatting"
+                     def { writerVariables = Context $ M.fromList
+                             [(pack "monofont", toVal $ pack "Consolas")] }
+                     "pptx/code/input.native"
+                     "pptx/code-custom/output.pptx"
+                   , pptxTests ("Using slide level 0, if the first thing on "
+                                <> "a slide is a h1 it's used as the "
+                                <> "slide title")
+                     def { writerSlideLevel = Just 0 }
+                     "pptx/slide-level-0/h1-with-image/input.native"
+                     "pptx/slide-level-0/h1-with-image/output.pptx"
+                   , pptxTests ("Using slide level 0, if the first thing on "
+                                <> "a slide is a h2 it's used as the "
+                                <> "slide title")
+                     def { writerSlideLevel = Just 0 }
+                     "pptx/slide-level-0/h2-with-image/input.native"
+                     "pptx/slide-level-0/h2-with-image/output.pptx"
+                   , pptxTests ("Using slide level 0, if the first thing on "
+                                <> "a slide is a heading it's used as the "
+                                <> "slide title (works with a table)")
+                     def { writerSlideLevel = Just 0 }
+                     "pptx/slide-level-0/h1-with-table/input.native"
+                     "pptx/slide-level-0/h1-with-table/output.pptx"
+                   , pptxTests ("Using slide level 0, if the first thing on "
+                                <> "a slide is a heading it's used as the "
+                                <> "slide title (content with caption layout)")
+                     def { writerSlideLevel = Just 0 }
+                     "pptx/slide-level-0/h1-h2-with-table/input.native"
+                     "pptx/slide-level-0/h1-h2-with-table/output.pptx"
+                   , pptxTests ("comparison layout used when two columns "
+                                <> "contain text plus non-text")
+                     def
+                     "pptx/comparison/both-columns/input.native"
+                     "pptx/comparison/both-columns/output.pptx"
+                   , pptxTests ("comparison layout used even when only one "
+                                <> "column contains text plus non-text")
+                     def
+                     "pptx/comparison/one-column/input.native"
+                     "pptx/comparison/one-column/output.pptx"
+                   , pptxTests ("extra text in one column in comparison "
+                                <> "layout gets overlaid")
+                     def
+                     "pptx/comparison/extra-text/input.native"
+                     "pptx/comparison/extra-text/output.pptx"
+                   , pptxTests ("extra image in one column in comparison "
+                               <> "layout gets overlaid")
+                     def
+                     "pptx/comparison/extra-image/input.native"
+                     "pptx/comparison/extra-image/output.pptx"
+                   , pptxTests "comparison not used if the non-text comes first"
+                     def
+                     "pptx/comparison/non-text-first/input.native"
+                     "pptx/comparison/non-text-first/output.pptx"
+                   , pptxTests ("Heading, text and an image on the same "
+                                <> "slide uses the Content with Caption "
+                                <> "layout")
+                     def
+                     "pptx/content-with-caption/heading-text-image/input.native"
+                     "pptx/content-with-caption/heading-text-image/output.pptx"
+                   , pptxTests ("Text and an image on the same "
+                                <> "slide uses the Content with Caption "
+                                <> "layout")
+                     def
+                     "pptx/content-with-caption/text-image/input.native"
+                     "pptx/content-with-caption/text-image/output.pptx"
+                   , pptxTests ("If the image comes first, Content with "
+                                <> "Caption is not used")
+                     def
+                     "pptx/content-with-caption/image-text/input.native"
+                     "pptx/content-with-caption/image-text/output.pptx"
+                   , pptxTests ("If a slide contains only speaker notes, the "
+                                <> "Blank layout is used")
+                     def
+                     "pptx/blanks/just-speaker-notes/input.native"
+                     "pptx/blanks/just-speaker-notes/output.pptx"
+                   , pptxTests ("If a slide contains only an empty heading "
+                                <> "with a body of only non-breaking spaces"
+                                <> ", the Blank layout is used")
+                     def
+                     "pptx/blanks/nbsp-in-body/input.native"
+                     "pptx/blanks/nbsp-in-body/output.pptx"
+                   , pptxTests ("If a slide contains only a heading "
+                                <> "containing only non-breaking spaces, "
+                                <> "the Blank layout is used")
+                     def
+                     "pptx/blanks/nbsp-in-heading/input.native"
+                     "pptx/blanks/nbsp-in-heading/output.pptx"
+                   , pptxTests ("Incremental lists are supported")
+                     def { writerIncremental = True }
+                     "pptx/incremental-lists/with-flag/input.native"
+                     "pptx/incremental-lists/with-flag/output.pptx"
+                   , pptxTests ("One-off incremental lists are supported")
+                     def
+                     "pptx/incremental-lists/without-flag/input.native"
+                     "pptx/incremental-lists/without-flag/output.pptx"
+                   , pptxTests "Background images"
+                     def
+                     "pptx/background-image/input.native"
+                     "pptx/background-image/output.pptx"
+                   ]
+  referenceSpecificTests =
+    [ ooxmlTest
+      writePowerpoint
+      "Basic footer"
+      def { writerReferenceDoc = Just "pptx/footer/basic/reference.pptx"}
+      "pptx/footer/input.native"
+      "pptx/footer/basic/output.pptx"
+    , ooxmlTest
+      writePowerpoint
+      "Footer with fixed date, replaced by meta block date"
+      def { writerReferenceDoc = Just "pptx/footer/fixed-date/reference.pptx"}
+      "pptx/footer/input.native"
+      "pptx/footer/fixed-date/output.pptx"
+    , ooxmlTest
+      writePowerpoint
+      "Footer not shown on title slide"
+      def { writerReferenceDoc = Just "pptx/footer/no-title-slide/reference.pptx"}
+      "pptx/footer/input.native"
+      "pptx/footer/no-title-slide/output.pptx"
+    , ooxmlTest
+      writePowerpoint
+      "Footer with slide number starting from 3"
+      def { writerReferenceDoc = Just "pptx/footer/higher-slide-number/reference.pptx"}
+      "pptx/footer/input.native"
+      "pptx/footer/higher-slide-number/output.pptx"
+    ]
+  in regularTests <> referenceSpecificTests
diff --git a/test/pptx/footer/basic/output.pptx b/test/pptx/footer/basic/output.pptx
new file mode 100644
index 000000000..db8814418
--- /dev/null
+++ b/test/pptx/footer/basic/output.pptx
diff --git a/test/pptx/footer/basic/reference.pptx b/test/pptx/footer/basic/reference.pptx
new file mode 100644
index 000000000..61f926fa6
--- /dev/null
+++ b/test/pptx/footer/basic/reference.pptx
diff --git a/test/pptx/footer/fixed-date/output.pptx b/test/pptx/footer/fixed-date/output.pptx
new file mode 100644
index 000000000..85854a744
--- /dev/null
+++ b/test/pptx/footer/fixed-date/output.pptx
diff --git a/test/pptx/footer/fixed-date/reference.pptx b/test/pptx/footer/fixed-date/reference.pptx
new file mode 100644
index 000000000..78bd3ce0d
--- /dev/null
+++ b/test/pptx/footer/fixed-date/reference.pptx
diff --git a/test/pptx/footer/higher-slide-number/output.pptx b/test/pptx/footer/higher-slide-number/output.pptx
new file mode 100644
index 000000000..c5bc3d047
--- /dev/null
+++ b/test/pptx/footer/higher-slide-number/output.pptx
diff --git a/test/pptx/footer/higher-slide-number/reference.pptx b/test/pptx/footer/higher-slide-number/reference.pptx
new file mode 100644
index 000000000..6ada45399
--- /dev/null
+++ b/test/pptx/footer/higher-slide-number/reference.pptx
diff --git a/test/pptx/footer/input.native b/test/pptx/footer/input.native
new file mode 100644
index 000000000..2c0ae5c06
--- /dev/null
+++ b/test/pptx/footer/input.native
@@ -0,0 +1,66 @@
+Pandoc (Meta {unMeta = fromList [("author",MetaInlines [Str "Me"]),("date",MetaInlines [Str "14/09/1995"]),("title",MetaInlines [Str "Slides"])]})
+[Header 2 ("slide-1",[],[]) [Str "Slide",Space,Str "1"]
+,Para [Str "Hello",Space,Str "there"]
+,Header 1 ("layouts",[],[]) [Str "Layouts"]
+,Header 2 ("slide-3",[],[]) [Str "Slide",Space,Str "3"]
+,Para [Str "Does",Space,Str "it",Space,Str "work",Space,Str "on",Space,Str "other",Space,Str "layouts?"]
+,Table ("",[],[]) (Caption Nothing
+ [])
+ [(AlignDefault,ColWidth 5.555555555555555e-2)
+ ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+ (TableHead ("",[],[])
+ [])
+ [(TableBody ("",[],[]) (RowHeadColumns 0)
+  []
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+    [Plain [Str "1"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+    [Plain [Str "2"]]]])]
+ (TableFoot ("",[],[])
+ [])
+,Header 2 ("slide-4",[],[]) [Str "Slide",Space,Str "4"]
+,Div ("",["columns"],[])
+ [Div ("",["column"],[])
+  [Para [Str "hello",Space,Str "hello"]]
+ ,Div ("",["column"],[])
+  [Para [Str "goood",Space,Str "bye"]]]
+,Header 2 ("slide-5",[],[]) [Str "Slide",Space,Str "5"]
+,Div ("",["columns"],[])
+ [Div ("",["column"],[])
+  [Para [Str "Hello",Space,Str "there"]
+  ,Table ("",[],[]) (Caption Nothing
+   [])
+   [(AlignDefault,ColWidth 5.555555555555555e-2)
+   ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+   (TableHead ("",[],[])
+   [])
+   [(TableBody ("",[],[]) (RowHeadColumns 0)
+    []
+    [Row ("",[],[])
+     [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+      [Plain [Str "1"]]
+     ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+      [Plain [Str "2"]]]])]
+   (TableFoot ("",[],[])
+   [])]
+ ,Div ("",["column"],[])
+  [Para [Str "oh",Space,Str "wait"]
+  ,Table ("",[],[]) (Caption Nothing
+   [])
+   [(AlignDefault,ColWidth 5.555555555555555e-2)
+   ,(AlignDefault,ColWidth 5.555555555555555e-2)]
+   (TableHead ("",[],[])
+   [])
+   [(TableBody ("",[],[]) (RowHeadColumns 0)
+    []
+    [Row ("",[],[])
+     [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+      [Plain [Str "1"]]
+     ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1)
+      [Plain [Str "2"]]]])]
+   (TableFoot ("",[],[])
+   [])]]
+,Header 2 ("section",[],[]) []
+,Div ("",["notes"],[])
+ [Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "blank",Space,Str "slide:",Space,Str "does",Space,Str "it",Space,Str "have",Space,Str "a",Space,Str "footer?"]]]
diff --git a/test/pptx/footer/no-title-slide/output.pptx b/test/pptx/footer/no-title-slide/output.pptx
new file mode 100644
index 000000000..d1475bf1f
--- /dev/null
+++ b/test/pptx/footer/no-title-slide/output.pptx
diff --git a/test/pptx/footer/no-title-slide/reference.pptx b/test/pptx/footer/no-title-slide/reference.pptx
new file mode 100644
index 000000000..ecd524a9b
--- /dev/null
+++ b/test/pptx/footer/no-title-slide/reference.pptx