bfef2cb · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Powerpoint writer: Add docProps to Presentation datatype.

bfef2cbJesse Rosenthal9 years ago

src/Text/Pandoc/Writers/Powerpoint/Output.hs+5−5

compare with master

unifiedsplit

@@ -213,7 +213,7 @@ requiredFiles = [ "docProps/app.xml"

213

214

215presentationToArchiveP :: PandocMonad m => Presentation -> P m Archive

216−presentationToArchiveP p@(Presentation slides) = do

216+presentationToArchiveP p@(Presentation _ slides) = do

217 filePaths <- patternsToFilePaths inheritedPatterns

218

219 -- make sure all required files are available:

@@ -247,7 +247,7 @@ presentationToArchiveP p@(Presentation slides) = do

247 [contentTypesEntry, relsEntry, presEntry, presRelsEntry]

248

249makeSlideIdMap :: Presentation -> M.Map SlideId Int

250−makeSlideIdMap (Presentation slides) =

250+makeSlideIdMap (Presentation _ slides) =

251 M.fromList $ (map slideId slides) `zip` [1..]

252

253presentationToArchive :: PandocMonad m => WriterOptions -> Presentation -> m Archive

@@ -1142,7 +1142,7 @@ getRels = do

1142 return $ mapMaybe elementToRel relElems

1143

1144presentationToRels :: PandocMonad m => Presentation -> P m [Relationship]

1145−presentationToRels (Presentation slides) = do

1145+presentationToRels (Presentation _ slides) = do

1146 mySlideRels <- mapM slideToPresRel slides

1147 rels <- getRels

1148 let relsWithoutSlides = filter (\r -> relType r /= "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide") rels

@@ -1288,7 +1288,7 @@ slideToSldIdElement slide = do

1288 return $ mknode "p:sldId" [("id", id'), ("r:id", rId)] ()

1289

1290presentationToSldIdLst :: PandocMonad m => Presentation -> P m Element

1291−presentationToSldIdLst (Presentation slides) = do

1291+presentationToSldIdLst (Presentation _ slides) = do

1292 ids <- mapM slideToSldIdElement slides

1293 return $ mknode "p:sldIdLst" [] ids

1294

@@ -1384,7 +1384,7 @@ mediaContentType mInfo

1384 | otherwise = Nothing

1385

1386presentationToContentTypes :: PandocMonad m => Presentation -> P m ContentTypes

1387−presentationToContentTypes (Presentation slides) = do

1387+presentationToContentTypes (Presentation _ slides) = do

1388 mediaInfos <- (mconcat . M.elems) <$> gets stMediaIds

1389 filePaths <- patternsToFilePaths inheritedPatterns

1390 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)

66import Text.Pandoc.Options

67import Text.Pandoc.Logging

68import Text.Pandoc.Walk

69+import Text.Pandoc.Compat.Time (UTCTime)

69import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"

70import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"

70import Text.Pandoc.Writers.Shared (metaValueToInlines)

71import Text.Pandoc.Writers.Shared (metaValueToInlines)

71import qualified Data.Map as M

72import qualified Data.Map as M

@@ -161,9 +162,16 @@ concatMapM f xs = liftM concat (mapM f xs)

161

162

162type Pixels = Integer

163type Pixels = Integer

163

164

164−data Presentation = Presentation [Slide]

165+data Presentation = Presentation DocProps [Slide]

165 deriving (Show)

166 deriving (Show)

166

167

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+

167

175

168data Slide = Slide { slideId :: SlideId

176data Slide = Slide { slideId :: SlideId

169 , slideLayout :: Layout

177 , slideLayout :: Layout

@@ -796,8 +804,8 @@ replaceAnchor (Run rProps s)

796 return $ Run rProps' s

804 return $ Run rProps' s

797replaceAnchor pe = return pe

805replaceAnchor pe = return pe

798

806

799−blocksToPresentation :: [Block] -> Pres Presentation

807+blocksToPresentationSlides :: [Block] -> Pres [Slide]

800−blocksToPresentation blks = do

808+blocksToPresentationSlides blks = do

801 opts <- asks envOpts

809 opts <- asks envOpts

802 metadataslides <- maybeToList <$> getMetaSlide

810 metadataslides <- maybeToList <$> getMetaSlide

803 -- As far as I can tell, if we want to have a variable-length toc in

811 -- As far as I can tell, if we want to have a variable-length toc in

@@ -836,17 +844,36 @@ blocksToPresentation blks = do

836 return [endNotesSlide]

844 return [endNotesSlide]

837

845

838 let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides

846 let slides = metadataslides ++ tocSlides ++ bodyslides ++ endNotesSlides

839− slides' <- mapM (applyToSlide replaceAnchor) slides

847+ mapM (applyToSlide replaceAnchor) slides

840− return $ Presentation 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+ }

841

865

842documentToPresentation :: WriterOptions

866documentToPresentation :: WriterOptions

843 -> Pandoc

867 -> Pandoc

844 -> (Presentation, [LogMessage])

868 -> (Presentation, [LogMessage])

845−documentToPresentation opts (Pandoc meta blks) = do

869+documentToPresentation opts (Pandoc meta blks) =

846 let env = def { envOpts = opts

870 let env = def { envOpts = opts

847 , envMetadata = meta

871 , envMetadata = meta

848 , envSlideLevel = case writerSlideLevel opts of

872 , envSlideLevel = case writerSlideLevel opts of

849 Just lvl -> lvl

873 Just lvl -> lvl

850 Nothing -> getSlideLevel blks

874 Nothing -> getSlideLevel blks

851 }

875 }

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)