1{-# LANGUAGE NoImplicitPrelude #-} 2module Tests.Writers.Powerpoint (tests) where 3 4import Prelude 5import Tests.Writers.OOXML (ooxmlTest) 6import Text.Pandoc 7import Test.Tasty 8import System.FilePath 9import Text.DocTemplates (ToContext(toVal), Context(..)) 10import qualified Data.Map as M 11import Data.Text (pack) 12 13-- templating is important enough, and can break enough things, that 14-- we want to run all our tests with both default formatting and a 15-- template. 16 17modifyPptxName :: FilePath -> FilePath 18modifyPptxName fp = 19 addExtension (dropExtension fp ++ "_templated") "pptx" 20 21pptxTests :: String -> WriterOptions -> FilePath -> FilePath -> (TestTree, TestTree) 22pptxTests name opts native pptx = 23 let referenceDoc = "pptx/reference_depth.pptx" 24 in 25 ( ooxmlTest 26 writePowerpoint 27 name 28 opts{writerReferenceDoc=Nothing} 29 native 30 pptx 31 , ooxmlTest 32 writePowerpoint 33 name 34 opts{writerReferenceDoc=Just referenceDoc} 35 native 36 (modifyPptxName pptx) 37 ) 38 39groupPptxTests :: [(TestTree, TestTree)] -> [TestTree] 40groupPptxTests pairs = 41 let (noRefs, refs) = unzip pairs 42 in 43 [ testGroup "Default slide formatting" noRefs 44 , testGroup "With `--reference-doc` pptx file" refs 45 ] 46 47 48tests :: [TestTree] 49tests = groupPptxTests [ pptxTests "Inline formatting" 50 def 51 "pptx/inline_formatting.native" 52 "pptx/inline_formatting.pptx" 53 , pptxTests "Slide breaks (default slide-level)" 54 def 55 "pptx/slide_breaks.native" 56 "pptx/slide_breaks.pptx" 57 , pptxTests "slide breaks (slide-level set to 1)" 58 def{ writerSlideLevel = Just 1 } 59 "pptx/slide_breaks.native" 60 "pptx/slide_breaks_slide_level_1.pptx" 61 , pptxTests "lists" 62 def 63 "pptx/lists.native" 64 "pptx/lists.pptx" 65 , pptxTests "start ordered list at specified num" 66 def 67 "pptx/start_numbering_at.native" 68 "pptx/start_numbering_at.pptx" 69 , pptxTests "tables" 70 def 71 "pptx/tables.native" 72 "pptx/tables.pptx" 73 , pptxTests "table of contents" 74 def{ writerTableOfContents = True } 75 "pptx/slide_breaks.native" 76 "pptx/slide_breaks_toc.pptx" 77 , pptxTests "end notes" 78 def 79 "pptx/endnotes.native" 80 "pptx/endnotes.pptx" 81 , pptxTests "end notes, with table of contents" 82 def { writerTableOfContents = True } 83 "pptx/endnotes.native" 84 "pptx/endnotes_toc.pptx" 85 , pptxTests "images" 86 def 87 "pptx/images.native" 88 "pptx/images.pptx" 89 , pptxTests "two-column layout" 90 def 91 "pptx/two_column.native" 92 "pptx/two_column.pptx" 93 , pptxTests "speaker notes" 94 def 95 "pptx/speaker_notes.native" 96 "pptx/speaker_notes.pptx" 97 , pptxTests "speaker notes after a separating block" 98 def 99 "pptx/speaker_notes_afterseps.native" 100 "pptx/speaker_notes_afterseps.pptx" 101 , pptxTests "speaker notes after a separating header" 102 def 103 "pptx/speaker_notes_afterheader.native" 104 "pptx/speaker_notes_afterheader.pptx" 105 , pptxTests "speaker notes after metadata" 106 def 107 "pptx/speaker_notes_after_metadata.native" 108 "pptx/speaker_notes_after_metadata.pptx" 109 , pptxTests "remove empty slides" 110 def 111 "pptx/remove_empty_slides.native" 112 "pptx/remove_empty_slides.pptx" 113 , pptxTests "raw ooxml" 114 def 115 "pptx/raw_ooxml.native" 116 "pptx/raw_ooxml.pptx" 117 , pptxTests "metadata, custom properties" 118 def 119 "pptx/document-properties.native" 120 "pptx/document-properties.pptx" 121 , pptxTests "metadata, short description" 122 def 123 "pptx/document-properties-short-desc.native" 124 "pptx/document-properties-short-desc.pptx" 125 , pptxTests "inline code and code blocks" 126 def 127 "pptx/code.native" 128 "pptx/code.pptx" 129 , pptxTests "inline code and code blocks, custom formatting" 130 def { writerVariables = Context $ M.fromList 131 [(pack "monofont", toVal $ pack "Consolas")] } 132 "pptx/code.native" 133 "pptx/code-custom.pptx" 134 ] 135