1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.Powerpoint (tests) where
import Text.Pandoc
import Text.Pandoc.Builder
import Test.Tasty
import Test.Tasty.HUnit
import Codec.Archive.Zip
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]
|
