git.iko.soy/typeable/pandoc
on master help sign in
Powerpoint writer: Add docProps to Presentation datatype.

This picks up the necessary information from meta and carries it over to the XML output, so Output.hs doesn't need access to the original pandoc information.

commitbfef2cbbf33ac1ebc2a1b90a78a9598b3bc76169 authorJesse Rosenthal <jrosenthal@jhu.edu> dateThu 18 Jan 2018, 08:17 (9 years ago) parenta516198
2 files changed+39−12
compare with master
unifiedsplit
src/Text/Pandoc/Writers/Powerpoint/Output.hs+5−5 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+34−7
src/Text/Pandoc/Writers/Powerpoint/Output.hs+5−5
@@ -213,7 +213,7 @@ requiredFiles = [ "docProps/app.xml"
213213
214214
215215presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive
216−presentationToArchiveP p@(Presentation slides) = do
216+presentationToArchiveP p@(Presentation _ slides) = do
217217 filePaths <- patternsToFilePaths inheritedPatterns
218218
219219 -- make sure all required files are available:
@@ -247,7 +247,7 @@ presentationToArchiveP p@(Presentation slides) = do
247247 [contentTypesEntry, relsEntry, presEntry, presRelsEntry]
248248
249249makeSlideIdMap :: Presentation -> M.Map SlideId Int
250−makeSlideIdMap (Presentation slides) =
250+makeSlideIdMap (Presentation _ slides) =
251251 M.fromList $ (map slideId slides) `zip` [1..]
252252
253253presentationToArchive :: PandocMonad m => WriterOptions -> Presentation -> m Archive
@@ -1142,7 +1142,7 @@ getRels = do
11421142 return $ mapMaybe elementToRel relElems
11431143
11441144presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]
1145−presentationToRels (Presentation slides) = do
1145+presentationToRels (Presentation _ slides) = do
11461146 mySlideRels <- mapM slideToPresRel slides
11471147 rels <- getRels
11481148 let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels
@@ -1288,7 +1288,7 @@ slideToSldIdElement slide = do
12881288 return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()
12891289
12901290presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element
1291−presentationToSldIdLst (Presentation slides) = do
1291+presentationToSldIdLst (Presentation _ slides) = do
12921292 ids <- mapM slideToSldIdElement slides
12931293 return $ mknode "p:sldIdLst" [] ids
12941294
@@ -1384,7 +1384,7 @@ mediaContentType mInfo
13841384 | otherwise = Nothing
13851385
13861386presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes
1387−presentationToContentTypes (Presentation slides) = do
1387+presentationToContentTypes (Presentation _ slides) = do
13881388 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds
13891389 filePaths <- patternsToFilePaths inheritedPatterns
13901390 let mediaFps = filter (match (compile "ppt/media/image*")) filePaths
src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+34−7
@@ -66,6 +66,7 @@ import Text.Pandoc.Slides (getSlideLevel)
6666import Text.Pandoc.Options
6767import Text.Pandoc.Logging
6868import Text.Pandoc.Walk
69+import Text.Pandoc.Compat.Time (UTCTime)
6970import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
7071import Text.Pandoc.Writers.Shared (metaValueToInlines)
7172import qualified Data.Map as M
@@ -161,9 +162,16 @@ concatMapM f xs = liftM concat (mapM f xs)
161162
162163type Pixels = Integer
163164
164−data Presentation = Presentation [Slide]
165+data Presentation = Presentation DocProps [Slide]
165166 deriving (Show)
166167
168+data DocProps = DocProps { dcTitle :: Maybe String
169+ , dcSubject :: Maybe String
170+ , dcCreator :: Maybe String
171+ , dcKeywords :: Maybe [String]
172+ , dcCreated :: Maybe UTCTime
173+ } deriving (Show, Eq)
174+
167175
168176data Slide = Slide { slideId :: SlideId
169177 , slideLayout :: Layout
@@ -796,8 +804,8 @@ replaceAnchor (Run rProps s)
796804 return $ Run rProps' s
797805replaceAnchor pe = return pe
798806
799−blocksToPresentation :: [Block] -> Pres Presentation
800−blocksToPresentation blks = do
807+blocksToPresentationSlides :: [Block] -> Pres [Slide]
808+blocksToPresentationSlides blks = do
801809 opts <- asks envOpts
802810 metadataslides <- maybeToList <$> getMetaSlide
803811 -- As far as I can tell, if we want to have a variable-length toc in
@@ -836,17 +844,36 @@ blocksToPresentation blks = do
836844 return [endNotesSlide]
837845
838846 let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides
839− slides' <- mapM (applyToSlide replaceAnchor) slides
840− return $ Presentation slides'
847+ mapM (applyToSlide replaceAnchor) slides
848+
849+metaToDocProps :: Meta -> DocProps
850+metaToDocProps meta =
851+ let keywords = case lookupMeta "keywords" meta of
852+ Just (MetaList xs) -> Just $ map Shared.stringify xs
853+ _ -> Nothing
854+
855+ authors = case lookupMeta "author" meta of
856+ Just (MetaList xs) -> Just $ map Shared.stringify xs
857+ _ -> Nothing
858+ in
859+ DocProps{ dcTitle = Shared.stringify <$> lookupMeta "title" meta
860+ , dcSubject = Shared.stringify <$> lookupMeta "subject" meta
861+ , dcCreator = (intercalate "; ") <$> authors
862+ , dcKeywords = keywords
863+ , dcCreated = Nothing
864+ }
841865
842866documentToPresentation :: WriterOptions
843867 -> Pandoc
844868 -> (Presentation, [LogMessage])
845−documentToPresentation opts (Pandoc meta blks) = do
869+documentToPresentation opts (Pandoc meta blks) =
846870 let env = def { envOpts = opts
847871 , envMetadata = meta
848872 , envSlideLevel = case writerSlideLevel opts of
849873 Just lvl -> lvl
850874 Nothing -> getSlideLevel blks
851875 }
852− runPres env def $ blocksToPresentation blks
876+ (presSlides, msgs) = runPres env def $ blocksToPresentationSlides blks
877+ docProps = metaToDocProps meta
878+ in
879+ (Presentation docProps presSlides, msgs)