aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2018-03-25 10:22:37 -0400
committerJesse Rosenthal <jrosenthal@jhu.edu>2018-03-25 10:22:37 -0400
commit2582de5384c80369a0bf5dcefba641505e1ca7be (patch)
treebfab5a2c14ffd6d9e686425096201c7a59048c68 /src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
parent4a8993f9b008a0ff223b5a1e283ae9e21a66c5c0 (diff)
downloadpandoc-2582de5384c80369a0bf5dcefba641505e1ca7be.tar.gz
Powerpoint writer: code cleanup.
Diffstat (limited to 'src/Text/Pandoc/Writers/Powerpoint/Presentation.hs')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs56
1 files changed, 17 insertions, 39 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index da3b8ffff..7a28268f9 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -401,10 +401,7 @@ noteSize :: Pixels
noteSize = 18
blockToParagraphs :: Block -> Pres [Paragraph]
-blockToParagraphs (Plain ils) = do
- parElems <- inlinesToParElems ils
- pProps <- asks envParaProps
- return [Paragraph pProps parElems]
+blockToParagraphs (Plain ils) = blockToParagraphs (Para ils)
blockToParagraphs (Para ils) = do
parElems <- inlinesToParElems ils
pProps <- asks envParaProps
@@ -519,14 +516,9 @@ withAttr attr (Pic picPr url caption) =
withAttr _ sp = sp
blockToShape :: Block -> Pres Shape
-blockToShape (Plain (il:_)) | Image attr ils (url, _) <- il =
- (withAttr attr . Pic def url) <$> inlinesToParElems ils
+blockToShape (Plain ils) = blockToShape (Para ils)
blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =
(withAttr attr . Pic def url) <$> inlinesToParElems ils
-blockToShape (Plain (il:_)) | Link _ (il':_) target <- il
- , Image attr ils (url, _) <- il' =
- (withAttr attr . Pic def {picPropLink = Just $ ExternalTarget target} url) <$>
- inlinesToParElems ils
blockToShape (Para (il:_)) | Link _ (il':_) target <- il
, Image attr ils (url, _) <- il' =
(withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} url) <$>
@@ -550,7 +542,6 @@ blockToShape blk = do paras <- blockToParagraphs blk
combineShapes :: [Shape] -> [Shape]
combineShapes [] = []
-combineShapes[s] = [s]
combineShapes (pic@Pic{} : ss) = pic : combineShapes ss
combineShapes (TextBox [] : ss) = combineShapes ss
combineShapes (s : TextBox [] : ss) = combineShapes (s : ss)
@@ -639,9 +630,9 @@ blocksToSlide' _ (blk : blks) spkNotes
, Div (_, clsL, _) blksL : Div (_, clsR, _) blksR : remaining <- divBlks
, "column" `elem` clsL, "column" `elem` clsR = do
unless (null blks)
- (mapM (addLogMessage . BlockNotRendered) blks >> return ())
+ (mapM_ (addLogMessage . BlockNotRendered) blks >> return ())
unless (null remaining)
- (mapM (addLogMessage . BlockNotRendered) remaining >> return ())
+ (mapM_ (addLogMessage . BlockNotRendered) remaining >> return ())
mbSplitBlksL <- splitBlocks blksL
mbSplitBlksR <- splitBlocks blksR
let blksL' = case mbSplitBlksL of
@@ -732,15 +723,14 @@ makeEndNotesSlideBlocks = do
anchorSet <- M.keysSet <$> gets stAnchorMap
if M.null noteIds
then return []
- else do let title = case lookupMeta "notes-title" meta of
- Just val -> metaValueToInlines val
- Nothing -> [Str "Notes"]
- ident = Shared.uniqueIdent title anchorSet
- hdr = Header slideLevel (ident, [], []) title
- blks <- return $
- concatMap (\(n, bs) -> makeNoteEntry n bs) $
+ else let title = case lookupMeta "notes-title" meta of
+ Just val -> metaValueToInlines val
+ Nothing -> [Str "Notes"]
+ ident = Shared.uniqueIdent title anchorSet
+ hdr = Header slideLevel (ident, [], []) title
+ blks = concatMap (\(n, bs) -> makeNoteEntry n bs) $
M.toList noteIds
- return $ hdr : blks
+ in return $ hdr : blks
getMetaSlide :: Pres (Maybe Slide)
getMetaSlide = do
@@ -791,8 +781,7 @@ makeTOCSlide blks = local (\env -> env{envCurSlideId = tocSlideId}) $ do
Just val -> metaValueToInlines val
Nothing -> [Str "Table of Contents"]
hdr = Header slideLevel nullAttr tocTitle
- sld <- blocksToSlide [hdr, contents]
- return sld
+ blocksToSlide [hdr, contents]
combineParaElems' :: Maybe ParaElem -> [ParaElem] -> [ParaElem]
combineParaElems' mbPElem [] = maybeToList mbPElem
@@ -815,15 +804,9 @@ applyToParagraph f para = do
return $ para {paraElems = paraElems'}
applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape
-applyToShape f (Pic pPr fp pes) = do
- pes' <- mapM f pes
- return $ Pic pPr fp pes'
-applyToShape f (GraphicFrame gfx pes) = do
- pes' <- mapM f pes
- return $ GraphicFrame gfx pes'
-applyToShape f (TextBox paras) = do
- paras' <- mapM (applyToParagraph f) paras
- return $ TextBox paras'
+applyToShape f (Pic pPr fp pes) = Pic pPr fp <$> mapM f pes
+applyToShape f (GraphicFrame gfx pes) = GraphicFrame gfx <$> mapM f pes
+applyToShape f (TextBox paras) = TextBox <$> mapM (applyToParagraph f) paras
applyToLayout :: Monad m => (ParaElem -> m ParaElem) -> Layout -> m Layout
applyToLayout f (MetadataSlide title subtitle authors date) = do
@@ -832,9 +815,7 @@ applyToLayout f (MetadataSlide title subtitle authors date) = do
authors' <- mapM (mapM f) authors
date' <- mapM f date
return $ MetadataSlide title' subtitle' authors' date'
-applyToLayout f (TitleSlide title) = do
- title' <- mapM f title
- return $ TitleSlide title'
+applyToLayout f (TitleSlide title) = TitleSlide <$> mapM f title
applyToLayout f (ContentSlide hdr content) = do
hdr' <- mapM f hdr
content' <- mapM (applyToShape f) content
@@ -896,10 +877,7 @@ emptyLayout layout = case layout of
all emptyShape shapes2
emptySlide :: Slide -> Bool
-emptySlide (Slide _ layout notes) =
- if notes == mempty
- then emptyLayout layout
- else False
+emptySlide (Slide _ layout notes) = (notes == mempty) && (emptyLayout layout)
blocksToPresentationSlides :: [Block] -> Pres [Slide]
blocksToPresentationSlides blks = do