Powerpoint writer: change notes state to a simpler per-slide value

We used to keep a map of the slideId-to-notes for each slide. Since we
now extract them at the slide level, this is overcomplicated, and we
can just extract them before converting a slide and then clear the
state after.
This commit is contained in:
Jesse Rosenthal 2018-03-23 13:58:22 -04:00
parent 59f3997069
commit 3b7611a7c7

View file

@ -113,7 +113,7 @@ data WriterState = WriterState { stNoteIds :: M.Map Int [Block]
, stAnchorMap :: M.Map String SlideId , stAnchorMap :: M.Map String SlideId
, stSlideIdSet :: S.Set SlideId , stSlideIdSet :: S.Set SlideId
, stLog :: [LogMessage] , stLog :: [LogMessage]
, stSpeakerNotesMap :: M.Map SlideId [[Paragraph]] , stSpeakerNotes :: SpeakerNotes
} deriving (Show, Eq) } deriving (Show, Eq)
instance Default WriterState where instance Default WriterState where
@ -122,7 +122,7 @@ instance Default WriterState where
-- we reserve this s -- we reserve this s
, stSlideIdSet = reservedSlideIds , stSlideIdSet = reservedSlideIds
, stLog = [] , stLog = []
, stSpeakerNotesMap = mempty , stSpeakerNotes = mempty
} }
metadataSlideId :: SlideId metadataSlideId :: SlideId
@ -196,7 +196,7 @@ newtype SlideId = SlideId String
-- designed mainly for one textbox, so we'll just put in the contents -- 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. -- of that textbox, to avoid other shapes that won't work as well.
newtype SpeakerNotes = SpeakerNotes {fromSpeakerNotes :: [Paragraph]} newtype SpeakerNotes = SpeakerNotes {fromSpeakerNotes :: [Paragraph]}
deriving (Show, Eq, Monoid) deriving (Show, Eq, Monoid, Semigroup)
data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem] data Layout = MetadataSlide { metadataSlideTitle :: [ParaElem]
, metadataSlideSubtitle :: [ParaElem] , metadataSlideSubtitle :: [ParaElem]
@ -565,13 +565,8 @@ isNotesDiv _ = False
handleNotes :: Block -> Pres () handleNotes :: Block -> Pres ()
handleNotes (Div (_, ["notes"], _) blks) = handleNotes (Div (_, ["notes"], _) blks) =
local (\env -> env{envInSpeakerNotes=True}) $ do local (\env -> env{envInSpeakerNotes=True}) $ do
sldId <- asks envCurSlideId spNotes <- SpeakerNotes <$> concatMapM blockToParagraphs blks
spkNotesMap <- gets stSpeakerNotesMap modify $ \st -> st{stSpeakerNotes = (stSpeakerNotes st) <> spNotes}
paras <- concatMapM blockToParagraphs blks
let spkNotesMap' = case M.lookup sldId spkNotesMap of
Just lst -> M.insert sldId (paras : lst) spkNotesMap
Nothing -> M.insert sldId [paras] spkNotesMap
modify $ \st -> st{stSpeakerNotesMap = spkNotesMap'}
handleNotes _ = return () handleNotes _ = return ()
handleAndFilterNotes :: [Block] -> Pres [Block] handleAndFilterNotes :: [Block] -> Pres [Block]
@ -632,13 +627,6 @@ splitBlocks' cur acc (blk : blks) = splitBlocks' (cur ++ [blk]) acc blks
splitBlocks :: [Block] -> Pres [[Block]] splitBlocks :: [Block] -> Pres [[Block]]
splitBlocks = splitBlocks' [] [] splitBlocks = splitBlocks' [] []
getSpeakerNotes :: Pres SpeakerNotes
getSpeakerNotes = do
sldId <- asks envCurSlideId
spkNtsMap <- gets stSpeakerNotesMap
let paras = fromMaybe [] (M.lookup sldId spkNtsMap)
return $ SpeakerNotes $ concat $ reverse paras
blocksToSlide' :: Int -> [Block] -> Pres Slide blocksToSlide' :: Int -> [Block] -> Pres Slide
blocksToSlide' lvl (Header n (ident, _, _) ils : blks) blocksToSlide' lvl (Header n (ident, _, _) ils : blks)
| n < lvl = do | n < lvl = do
@ -710,9 +698,10 @@ blocksToSlide' _ [] = do
blocksToSlide :: [Block] -> Pres Slide blocksToSlide :: [Block] -> Pres Slide
blocksToSlide blks = do blocksToSlide blks = do
slideLevel <- asks envSlideLevel slideLevel <- asks envSlideLevel
modify $ \st -> st{stSpeakerNotes = mempty}
blks' <- walkM handleAndFilterNotes blks blks' <- walkM handleAndFilterNotes blks
sld <- blocksToSlide' slideLevel blks' sld <- blocksToSlide' slideLevel blks'
spkNotes <- getSpeakerNotes spkNotes <- gets stSpeakerNotes
return $ sld{slideSpeakerNotes = spkNotes} return $ sld{slideSpeakerNotes = spkNotes}
makeNoteEntry :: Int -> [Block] -> [Block] makeNoteEntry :: Int -> [Block] -> [Block]