From 59f3997069131abaf9f206604971cc980d69071a Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Fri, 23 Mar 2018 13:00:30 -0400
Subject: Powerpoint writer: Remove `Maybe` from `SpeakerNotes` in `Slide`.
Previously, we had treated it as a `Maybe`. But there is no difference
between not having speaker notes and having empty speaker notes. So we
make the SpeakerNotes newtype into a monoid, and test for memptiness
instead of testing for Just/Nothing.
---
src/Text/Pandoc/Writers/Powerpoint/Output.hs | 104 ++++++++++-----------
src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 38 ++++----
2 files changed, 71 insertions(+), 71 deletions(-)
(limited to 'src/Text/Pandoc/Writers/Powerpoint')
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 8cb848ea6..2716bc08b 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -283,8 +283,9 @@ makeSlideIdMap (Presentation _ slides) =
makeSpeakerNotesMap :: Presentation -> M.Map Int Int
makeSpeakerNotesMap (Presentation _ slides) =
M.fromList $ (mapMaybe f $ slides `zip` [1..]) `zip` [1..]
- where f (Slide _ _ Nothing, _) = Nothing
- f (Slide _ _ (Just _), n) = Just n
+ where f (Slide _ _ notes, n) = if notes == mempty
+ then Nothing
+ else Just n
presentationToArchive :: PandocMonad m => WriterOptions -> Presentation -> m Archive
presentationToArchive opts pres = do
@@ -324,7 +325,7 @@ presentationToArchive opts pres = do
-- Check to see if the presentation has speaker notes. This will
-- influence whether we import the notesMaster template.
presHasSpeakerNotes :: Presentation -> Bool
-presHasSpeakerNotes (Presentation _ slides) = any isJust $ map slideSpeakerNotes slides
+presHasSpeakerNotes (Presentation _ slides) = not $ all (mempty ==) $ map slideSpeakerNotes slides
curSlideHasSpeakerNotes :: PandocMonad m => P m Bool
curSlideHasSpeakerNotes = do
@@ -1272,42 +1273,40 @@ speakerNotesSlideNumber pgNum fieldId =
]
slideToSpeakerNotesElement :: PandocMonad m => Slide -> P m (Maybe Element)
-slideToSpeakerNotesElement slide
- | Slide _ _ mbNotes <- slide
- , Just (SpeakerNotes paras) <- mbNotes = do
- master <- getNotesMaster
- fieldId <- getSlideNumberFieldId master
- num <- slideNum slide
- let imgShape = speakerNotesSlideImage
- sldNumShape = speakerNotesSlideNumber num fieldId
- bodyShape <- speakerNotesBody paras
- return $ Just $
- mknode "p:notes"
- [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
- , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
- , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
- ] [ mknode "p:cSld" []
- [ mknode "p:spTree" []
- [ mknode "p:nvGrpSpPr" []
- [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
- , mknode "p:cNvGrpSpPr" [] ()
- , mknode "p:nvPr" [] ()
- ]
- , mknode "p:grpSpPr" []
- [ mknode "a:xfrm" []
- [ mknode "a:off" [("x", "0"), ("y", "0")] ()
- , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
- , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
- , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
- ]
- ]
- , imgShape
- , bodyShape
- , sldNumShape
+slideToSpeakerNotesElement (Slide _ _ (SpeakerNotes [])) = return Nothing
+slideToSpeakerNotesElement slide@(Slide _ _ (SpeakerNotes paras)) = do
+ master <- getNotesMaster
+ fieldId <- getSlideNumberFieldId master
+ num <- slideNum slide
+ let imgShape = speakerNotesSlideImage
+ sldNumShape = speakerNotesSlideNumber num fieldId
+ bodyShape <- speakerNotesBody paras
+ return $ Just $
+ mknode "p:notes"
+ [ ("xmlns:a", "http://schemas.openxmlformats.org/drawingml/2006/main")
+ , ("xmlns:r", "http://schemas.openxmlformats.org/officeDocument/2006/relationships")
+ , ("xmlns:p", "http://schemas.openxmlformats.org/presentationml/2006/main")
+ ] [ mknode "p:cSld" []
+ [ mknode "p:spTree" []
+ [ mknode "p:nvGrpSpPr" []
+ [ mknode "p:cNvPr" [("id", "1"), ("name", "")] ()
+ , mknode "p:cNvGrpSpPr" [] ()
+ , mknode "p:nvPr" [] ()
]
+ , mknode "p:grpSpPr" []
+ [ mknode "a:xfrm" []
+ [ mknode "a:off" [("x", "0"), ("y", "0")] ()
+ , mknode "a:ext" [("cx", "0"), ("cy", "0")] ()
+ , mknode "a:chOff" [("x", "0"), ("y", "0")] ()
+ , mknode "a:chExt" [("cx", "0"), ("cy", "0")] ()
+ ]
]
+ , imgShape
+ , bodyShape
+ , sldNumShape
]
-slideToSpeakerNotesElement _ = return Nothing
+ ]
+ ]
-----------------------------------------------------------------------
@@ -1482,23 +1481,22 @@ slideToSpeakerNotesEntry slide = do
_ -> return Nothing
slideToSpeakerNotesRelElement :: PandocMonad m => Slide -> P m (Maybe Element)
-slideToSpeakerNotesRelElement slide
- | Slide _ _ mbNotes <- slide
- , Just _ <- mbNotes = do
- idNum <- slideNum slide
- return $ Just $
- mknode "Relationships"
- [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
- [ mknode "Relationship" [ ("Id", "rId2")
- , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
- , ("Target", "../slides/slide" ++ show idNum ++ ".xml")
- ] ()
- , mknode "Relationship" [ ("Id", "rId1")
- , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
- , ("Target", "../notesMasters/notesMaster1.xml")
- ] ()
- ]
-slideToSpeakerNotesRelElement _ = return Nothing
+slideToSpeakerNotesRelElement (Slide _ _ (SpeakerNotes [])) = return Nothing
+slideToSpeakerNotesRelElement slide@(Slide _ _ _) = do
+ idNum <- slideNum slide
+ return $ Just $
+ mknode "Relationships"
+ [("xmlns", "http://schemas.openxmlformats.org/package/2006/relationships")]
+ [ mknode "Relationship" [ ("Id", "rId2")
+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")
+ , ("Target", "../slides/slide" ++ show idNum ++ ".xml")
+ ] ()
+ , mknode "Relationship" [ ("Id", "rId1")
+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/notesMaster")
+ , ("Target", "../notesMasters/notesMaster1.xml")
+ ] ()
+ ]
+
slideToSpeakerNotesRelEntry :: PandocMonad m => Slide -> P m (Maybe Entry)
slideToSpeakerNotesRelEntry slide = do
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 6d2c0834b..bf26840f7 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-
Copyright (C) 2017-2018 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -185,7 +186,7 @@ data DocProps = DocProps { dcTitle :: Maybe String
data Slide = Slide { slideId :: SlideId
, slideLayout :: Layout
- , slideSpeakerNotes :: Maybe SpeakerNotes
+ , slideSpeakerNotes :: SpeakerNotes
} deriving (Show, Eq)
newtype SlideId = SlideId String
@@ -195,7 +196,7 @@ newtype SlideId = SlideId String
-- designed mainly for one textbox, so we'll just put in the contents
-- of that textbox, to avoid other shapes that won't work as well.
newtype SpeakerNotes = SpeakerNotes {fromSpeakerNotes :: [Paragraph]}
- deriving (Show, Eq)
+ deriving (Show, Eq, Monoid)
data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem]
, metadataSlideSubtitle :: [ParaElem]
@@ -631,11 +632,12 @@ splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks = splitBlocks' [] []
-getSpeakerNotes :: Pres (Maybe SpeakerNotes)
+getSpeakerNotes :: Pres SpeakerNotes
getSpeakerNotes = do
sldId <- asks envCurSlideId
spkNtsMap <- gets stSpeakerNotesMap
- return $ (SpeakerNotes . concat . reverse) <$> M.lookup sldId spkNtsMap
+ let paras = fromMaybe [] (M.lookup sldId spkNtsMap)
+ return $ SpeakerNotes $ concat $ reverse paras
blocksToSlide' :: Int -> [Block] -> Pres Slide
blocksToSlide' lvl (Header n (ident, _, _) ils : blks)
@@ -643,7 +645,7 @@ blocksToSlide' lvl (Header n (ident, _, _) ils : blks)
registerAnchorId ident
sldId <- asks envCurSlideId
hdr <- inlinesToParElems ils
- return $ Slide sldId TitleSlide {titleSlideHeader = hdr} Nothing
+ return $ Slide sldId TitleSlide {titleSlideHeader = hdr} mempty
| n == lvl = do
registerAnchorId ident
hdr <- inlinesToParElems ils
@@ -681,7 +683,7 @@ blocksToSlide' _ (blk : blks)
, twoColumnSlideLeft = shapesL
, twoColumnSlideRight = shapesR
}
- Nothing
+ mempty
blocksToSlide' _ (blk : blks) = do
inNoteSlide <- asks envInNoteSlide
shapes <- if inNoteSlide
@@ -694,7 +696,7 @@ blocksToSlide' _ (blk : blks) = do
ContentSlide { contentSlideHeader = []
, contentSlideContent = shapes
}
- Nothing
+ mempty
blocksToSlide' _ [] = do
sldId <- asks envCurSlideId
return $
@@ -703,7 +705,7 @@ blocksToSlide' _ [] = do
ContentSlide { contentSlideHeader = []
, contentSlideContent = []
}
- Nothing
+ mempty
blocksToSlide :: [Block] -> Pres Slide
blocksToSlide blks = do
@@ -771,7 +773,7 @@ getMetaSlide = do
, metadataSlideAuthors = authors
, metadataSlideDate = date
}
- Nothing
+ mempty
-- adapted from the markdown writer
elementToListItem :: Shared.Element -> Pres [Block]
@@ -853,11 +855,9 @@ applyToLayout f (TwoColumnSlide hdr contentL contentR) = do
applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide
applyToSlide f slide = do
layout' <- applyToLayout f $ slideLayout slide
- mbNotes' <- case slideSpeakerNotes slide of
- Just (SpeakerNotes notes) -> (Just . SpeakerNotes) <$>
- mapM (applyToParagraph f) notes
- Nothing -> return Nothing
- return slide{slideLayout = layout', slideSpeakerNotes = mbNotes'}
+ let paras = fromSpeakerNotes $ slideSpeakerNotes slide
+ notes' <- SpeakerNotes <$> mapM (applyToParagraph f) paras
+ return slide{slideLayout = layout', slideSpeakerNotes = notes'}
replaceAnchor :: ParaElem -> Pres ParaElem
replaceAnchor (Run rProps s)
@@ -903,8 +903,10 @@ emptyLayout layout = case layout of
all emptyShape shapes2
emptySlide :: Slide -> Bool
-emptySlide (Slide _ layout Nothing) = emptyLayout layout
-emptySlide _ = False
+emptySlide (Slide _ layout notes) =
+ if notes == mempty
+ then emptyLayout layout
+ else False
blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides blks = do
--
cgit v1.2.3