From a465e2c059ceb7f58279e25b11159c8fd391bde7 Mon Sep 17 00:00:00 2001
From: "Joseph C. Sible" <josephcsible@users.noreply.github.com>
Date: Mon, 30 Mar 2020 00:24:42 -0400
Subject: [PATCH] Clean up and simplify Text.Pandoc.Readers.Docx (#6225)
* Simplify resolveDependentRunStyle
* Simplify runToInlines
* Simplify isAnchorSpan
* Simplify parStyleToTransform
* Only call getStyleName once
* Simplify ils''
* Use case matching to simplify bodyPartToBlocks
* Simplify key expiration
---
src/Text/Pandoc/Readers/Docx.hs | 104 +++++++++++++-------------------
1 file changed, 43 insertions(+), 61 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 599083949..f616a5b7a 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -253,9 +253,7 @@ blacklistedCharStyles = ["Hyperlink"]
resolveDependentRunStyle :: PandocMonad m => RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle rPr
| Just s <- rParentStyle rPr
- , getStyleName s `elem` blacklistedCharStyles =
- return rPr
- | Just s <- rParentStyle rPr = do
+ , getStyleName s `notElem` blacklistedCharStyles = do
opts <- asks docxOptions
if isEnabled Ext_styles opts
then return rPr
@@ -318,12 +316,8 @@ runToInlines (Run rs runElems)
let ils = smushInlines (map runElemToInlines runElems)
transform <- runStyleToTransform rPr
return $ transform ils
-runToInlines (Footnote bps) = do
- blksList <- smushBlocks <$> mapM bodyPartToBlocks bps
- return $ note blksList
-runToInlines (Endnote bps) = do
- blksList <- smushBlocks <$> mapM bodyPartToBlocks bps
- return $ note blksList
+runToInlines (Footnote bps) = note . smushBlocks <$> mapM bodyPartToBlocks bps
+runToInlines (Endnote bps) = note . smushBlocks <$> mapM bodyPartToBlocks bps
runToInlines (InlineDrawing fp title alt bs ext) = do
(lift . lift) $ P.insertMedia fp Nothing bs
return $ imageWith (extentToAttr ext) (T.pack fp) title $ text alt
@@ -455,9 +449,7 @@ parPartToInlines' (Field info runs) =
parPartToInlines' NullParPart = return mempty
isAnchorSpan :: Inline -> Bool
-isAnchorSpan (Span (_, classes, kvs) _) =
- classes == ["anchor"] &&
- null kvs
+isAnchorSpan (Span (_, ["anchor"], []) _) = True
isAnchorSpan _ = False
dummyAnchors :: [T.Text]
@@ -529,31 +521,30 @@ extraInfo f s = do
else id
parStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks)
-parStyleToTransform pPr
- | (c:cs) <- pStyle pPr
- , getStyleName c `elem` divsToKeep = do
- let pPr' = pPr { pStyle = cs }
- transform <- parStyleToTransform pPr'
- return $ divWith ("", [normalizeToClassName $ getStyleName c], []) . transform
- | (c:cs) <- pStyle pPr,
- getStyleName c `elem` listParagraphStyles = do
- let pPr' = pPr { pStyle = cs, indentation = Nothing}
- transform <- parStyleToTransform pPr'
- return $ divWith ("", [normalizeToClassName $ getStyleName c], []) . transform
- | (c:cs) <- pStyle pPr = do
- let pPr' = pPr { pStyle = cs }
- transform <- parStyleToTransform pPr'
- ei <- extraInfo divWith c
- return $ ei . (if isBlockQuote c then blockQuote else id) . transform
- | null (pStyle pPr)
- , Just left <- indentation pPr >>= leftParIndent = do
- let pPr' = pPr { indentation = Nothing }
- hang = fromMaybe 0 $ indentation pPr >>= hangingParIndent
- transform <- parStyleToTransform pPr'
- return $ if (left - hang) > 0
- then blockQuote . transform
- else transform
-parStyleToTransform _ = return id
+parStyleToTransform pPr = case pStyle pPr of
+ c@(getStyleName -> styleName):cs
+ | styleName `elem` divsToKeep -> do
+ let pPr' = pPr { pStyle = cs }
+ transform <- parStyleToTransform pPr'
+ return $ divWith ("", [normalizeToClassName styleName], []) . transform
+ | styleName `elem` listParagraphStyles -> do
+ let pPr' = pPr { pStyle = cs, indentation = Nothing}
+ transform <- parStyleToTransform pPr'
+ return $ divWith ("", [normalizeToClassName styleName], []) . transform
+ | otherwise -> do
+ let pPr' = pPr { pStyle = cs }
+ transform <- parStyleToTransform pPr'
+ ei <- extraInfo divWith c
+ return $ ei . (if isBlockQuote c then blockQuote else id) . transform
+ []
+ | Just left <- indentation pPr >>= leftParIndent -> do
+ let pPr' = pPr { indentation = Nothing }
+ hang = fromMaybe 0 $ indentation pPr >>= hangingParIndent
+ transform <- parStyleToTransform pPr'
+ return $ if (left - hang) > 0
+ then blockQuote . transform
+ else transform
+ | otherwise -> return id
normalizeToClassName :: (FromStyleName a) => a -> T.Text
normalizeToClassName = T.map go . fromStyleName
@@ -590,47 +581,41 @@ bodyPartToBlocks (Paragraph pPr parparts)
then do modify $ \s -> s { docxDropCap = ils' }
return mempty
else do modify $ \s -> s { docxDropCap = mempty }
- let ils'' = prevParaIls <>
- (if isNull prevParaIls then mempty else space) <>
- ils'
+ let ils'' = (if isNull prevParaIls then mempty
+ else prevParaIls <> space) <> ils'
handleInsertion = do
modify $ \s -> s {docxPrevPara = mempty}
transform <- parStyleToTransform pPr'
return $ transform $ paraOrPlain ils''
opts <- asks docxOptions
- if | isNull ils'' && not (isEnabled Ext_empty_paragraphs opts) ->
+ case (pChange pPr', readerTrackChanges opts) of
+ _ | isNull ils'', not (isEnabled Ext_empty_paragraphs opts) ->
return mempty
- | Just (TrackedChange Insertion _) <- pChange pPr'
- , AcceptChanges <- readerTrackChanges opts ->
+ (Just (TrackedChange Insertion _), AcceptChanges) ->
handleInsertion
- | Just (TrackedChange Insertion _) <- pChange pPr'
- , RejectChanges <- readerTrackChanges opts -> do
+ (Just (TrackedChange Insertion _), RejectChanges) -> do
modify $ \s -> s {docxPrevPara = ils''}
return mempty
- | Just (TrackedChange Insertion cInfo) <- pChange pPr'
- , AllChanges <- readerTrackChanges opts
- , ChangeInfo _ cAuthor cDate <- cInfo -> do
+ (Just (TrackedChange Insertion (ChangeInfo _ cAuthor cDate))
+ , AllChanges) -> do
let attr = ("", ["paragraph-insertion"], [("author", cAuthor), ("date", cDate)])
insertMark = spanWith attr mempty
transform <- parStyleToTransform pPr'
return $ transform $
paraOrPlain $ ils'' <> insertMark
- | Just (TrackedChange Deletion _) <- pChange pPr'
- , AcceptChanges <- readerTrackChanges opts -> do
+ (Just (TrackedChange Deletion _), AcceptChanges) -> do
modify $ \s -> s {docxPrevPara = ils''}
return mempty
- | Just (TrackedChange Deletion _) <- pChange pPr'
- , RejectChanges <- readerTrackChanges opts ->
+ (Just (TrackedChange Deletion _), RejectChanges) ->
handleInsertion
- | Just (TrackedChange Deletion cInfo) <- pChange pPr'
- , AllChanges <- readerTrackChanges opts
- , ChangeInfo _ cAuthor cDate <- cInfo -> do
+ (Just (TrackedChange Deletion (ChangeInfo _ cAuthor cDate))
+ , AllChanges) -> do
let attr = ("", ["paragraph-deletion"], [("author", cAuthor), ("date", cDate)])
insertMark = spanWith attr mempty
transform <- parStyleToTransform pPr'
return $ transform $
paraOrPlain $ ils'' <> insertMark
- | otherwise -> handleInsertion
+ _ -> handleInsertion
bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do
-- We check whether this current numId has previously been used,
-- since Docx expects us to pick up where we left off.
@@ -649,11 +634,8 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do
modify $ \st -> st{ docxListState =
-- expire all the continuation data for lists of level > this one:
-- a new level 1 list item resets continuation for level 2+
- let expireKeys = [ (numid', lvl')
- | (numid', lvl') <- M.keys listState
- , lvl' > lvl
- ]
- in foldr M.delete (M.insert (numId, lvl) start listState) expireKeys }
+ let notExpired (_, lvl') _ = lvl' <= lvl
+ in M.insert (numId, lvl) start (M.filterWithKey notExpired listState) }
blks <- bodyPartToBlocks (Paragraph pPr parparts)
return $ divWith ("", ["list-item"], kvs) blks
bodyPartToBlocks (ListItem pPr _ _ _ parparts) =