Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

[Docx Reader] Code clean-up

Browse source 
Reduce code duplication, remove redundant brackets, use newtype instead of data where appropriate
This commit is contained in:
Nikolay Yakimov 2019-09-08 16:47:44 +03:00 • committed by John MacFarlane
parent 6ceed9593a
commit fd14ad5261
2 changed files with 39 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
src/Text/Pandoc/Readers/Docx.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE MultiWayIf #-}
{- |
Module : Text.Pandoc.Readers.Docx
Copyright : Copyright (C) 2014-2019 Jesse Rosenthal
@ -129,7 +130,7 @@ instance Default DEnv where
type DocxContext m = ReaderT DEnv (StateT DState m)
evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a
evalDocxContext ctx env st = flip evalStateT st $flip runReaderT env ctx
evalDocxContext ctx env st = flip evalStateT st $ runReaderT ctx env
-- This is empty, but we put it in for future-proofing.
spansToKeep :: [String]
@ -537,15 +538,6 @@ parStyleToTransform pPr
let pPr' = pPr { pStyle = cs, indentation = Nothing}
transform <- parStyleToTransform pPr'
return $ divWith ("", [c], []) . transform
| (c:cs) <- pStyle pPr
, Just True <- pBlockQuote pPr = do
opts <- asks docxOptions
let pPr' = pPr { pStyle = cs }
transform <- parStyleToTransform pPr'
let extraInfo = if isEnabled Ext_styles opts
then divWith ("", [], [("custom-style", c)])
else id
return $ extraInfo . blockQuote . transform
| (c:cs) <- pStyle pPr = do
opts <- asks docxOptions
let pPr' = pPr { pStyle = cs}
@ -553,22 +545,15 @@ parStyleToTransform pPr
let extraInfo = if isEnabled Ext_styles opts
then divWith ("", [], [("custom-style", c)])
else id
return $ extraInfo . transform
return $ extraInfo . (if fromMaybe False (pBlockQuote pPr) then blockQuote else id) . transform
| null (pStyle pPr)
, Just left <- indentation pPr >>= leftParIndent
, Just hang <- indentation pPr >>= hangingParIndent = do
, Just left <- indentation pPr >>= leftParIndent = do
let pPr' = pPr { indentation = Nothing }
hang = fromMaybe 0 $ indentation pPr >>= hangingParIndent
transform <- parStyleToTransform pPr'
return $ case (left - hang) > 0 of
True -> blockQuote . transform
False -> transform
| null (pStyle pPr),
Just left <- indentation pPr >>= leftParIndent = do
let pPr' = pPr { indentation = Nothing }
transform <- parStyleToTransform pPr'
return $ case left > 0 of
True -> blockQuote . transform
False -> transform
return $ if (left - hang) > 0
then blockQuote . transform
else transform
parStyleToTransform _ = return id
bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks
@ -585,7 +570,7 @@ bodyPartToBlocks (Paragraph pPr parparts)
makeHeaderAnchor $
headerWith ("", delete style (pStyle pPr), []) n ils
| otherwise = do
ils <- (trimSps . smushInlines) <$> mapM parPartToInlines parparts
ils <- trimSps . smushInlines <$> mapM parPartToInlines parparts
prevParaIls <- gets docxPrevPara
dropIls <- gets docxDropCap
let ils' = dropIls <> ils
@ -596,21 +581,21 @@ bodyPartToBlocks (Paragraph pPr parparts)
let ils'' = prevParaIls <>
(if isNull prevParaIls then mempty else space) <>
ils'
handleInsertion = do
modify $ \s -> s {docxPrevPara = mempty}
transform <- parStyleToTransform pPr
return $ transform $ para ils''
opts <- asks docxOptions
case () of
_ | isNull ils'' && not (isEnabled Ext_empty_paragraphs opts) ->
if | isNull ils'' && not (isEnabled Ext_empty_paragraphs opts) ->
return mempty
_ | Just (TrackedChange Insertion _) <- pChange pPr
, AcceptChanges <- readerTrackChanges opts -> do
modify $ \s -> s {docxPrevPara = mempty}
transform <- parStyleToTransform pPr
return $ transform $ para ils''
_ | Just (TrackedChange Insertion _) <- pChange pPr
| Just (TrackedChange Insertion _) <- pChange pPr
, AcceptChanges <- readerTrackChanges opts ->
handleInsertion
| Just (TrackedChange Insertion _) <- pChange pPr
, RejectChanges <- readerTrackChanges opts -> do
modify $ \s -> s {docxPrevPara = ils''}
return mempty
_ | Just (TrackedChange Insertion cInfo) <- pChange pPr
| Just (TrackedChange Insertion cInfo) <- pChange pPr
, AllChanges <- readerTrackChanges opts
, ChangeInfo _ cAuthor cDate <- cInfo -> do
let attr = ("", ["paragraph-insertion"], [("author", cAuthor), ("date", cDate)])
@ -618,16 +603,14 @@ bodyPartToBlocks (Paragraph pPr parparts)
transform <- parStyleToTransform pPr
return $ transform $
para $ ils'' <> insertMark
_ | Just (TrackedChange Deletion _) <- pChange pPr
| Just (TrackedChange Deletion _) <- pChange pPr
, AcceptChanges <- readerTrackChanges opts -> do
modify $ \s -> s {docxPrevPara = ils''}
return mempty
_ | Just (TrackedChange Deletion _) <- pChange pPr
, RejectChanges <- readerTrackChanges opts -> do
modify $ \s -> s {docxPrevPara = mempty}
transform <- parStyleToTransform pPr
return $ transform $ para ils''
_ | Just (TrackedChange Deletion cInfo) <- pChange pPr
| Just (TrackedChange Deletion _) <- pChange pPr
, RejectChanges <- readerTrackChanges opts ->
handleInsertion
| Just (TrackedChange Deletion cInfo) <- pChange pPr
, AllChanges <- readerTrackChanges opts
, ChangeInfo _ cAuthor cDate <- cInfo -> do
let attr = ("", ["paragraph-deletion"], [("author", cAuthor), ("date", cDate)])
@ -635,10 +618,7 @@ bodyPartToBlocks (Paragraph pPr parparts)
transform <- parStyleToTransform pPr
return $ transform $
para $ ils'' <> insertMark
_ | otherwise -> do
modify $ \s -> s {docxPrevPara = mempty}
transform <- parStyleToTransform pPr
return $ transform $ para ils''
| otherwise -> 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.

32
src/Text/Pandoc/Readers/Docx/Parse.hs
View file

@ -121,9 +121,9 @@ unwrap :: NameSpaces -> Content -> [Content]
unwrap ns (Elem element)
| isElem ns "w" "sdt" element
, Just sdtContent <- findChildByName ns "w" "sdtContent" element
= concatMap ((unwrap ns) . Elem) (elChildren sdtContent)
= concatMap (unwrap ns . Elem) (elChildren sdtContent)
| isElem ns "w" "smartTag" element
= concatMap ((unwrap ns) . Elem) (elChildren element)
= concatMap (unwrap ns . Elem) (elChildren element)
unwrap _ content = [content]
unwrapChild :: NameSpaces -> Content -> Content
@ -149,13 +149,13 @@ walkDocument ns element =
_ -> Nothing
data Docx = Docx Document
newtype Docx = Docx Document
deriving Show
data Document = Document NameSpaces Body
deriving Show
data Body = Body [BodyPart]
newtype Body = Body [BodyPart]
deriving Show
type Media = [(FilePath, B.ByteString)]
@ -242,16 +242,16 @@ data BodyPart = Paragraph ParagraphStyle [ParPart]
type TblGrid = [Integer]
data TblLook = TblLook {firstRowFormatting::Bool}
newtype TblLook = TblLook {firstRowFormatting::Bool}
deriving Show
defaultTblLook :: TblLook
defaultTblLook = TblLook{firstRowFormatting = False}
data Row = Row [Cell]
newtype Row = Row [Cell]
deriving Show
data Cell = Cell [BodyPart]
newtype Cell = Cell [BodyPart]
deriving Show
-- (width, height) in EMUs
@ -495,7 +495,7 @@ filePathToRelType "word/_rels/endnotes.xml.rels" _ = Just InEndnote
-- -- to see if it's a documentPath, we have to check against the dynamic
-- -- docPath specified in "_rels/.rels"
filePathToRelType path docXmlPath =
if path == "word/_rels/" ++ (takeFileName docXmlPath) ++ ".rels"
if path == "word/_rels/" ++ takeFileName docXmlPath ++ ".rels"
then Just InDocument
else Nothing
@ -537,7 +537,7 @@ lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
case lvlOverride of
Just (LevelOverride _ _ (Just lvl')) -> Just lvl'
Just (LevelOverride _ (Just strt) _) ->
lookup ilvl $ map (\(Level i fmt s _) -> (i, (Level i fmt s (Just strt)))) lvls
lookup ilvl $ map (\(Level i fmt s _) -> (i, Level i fmt s (Just strt))) lvls
_ ->
lookup ilvl $ map (\l@(Level i _ _ _) -> (i, l)) lvls
@ -703,23 +703,19 @@ elemToBodyPart ns element
elemToBodyPart ns element
| isElem ns "w" "p" element
, Just (numId, lvl) <- getNumInfo ns element = do
sty <- asks envParStyles
let parstyle = elemToParagraphStyle ns element sty
parstyle <- elemToParagraphStyle ns element <$> asks envParStyles
parparts <- mapD (elemToParPart ns) (elChildren element)
num <- asks envNumbering
let levelInfo = lookupLevel numId lvl num
levelInfo <- lookupLevel numId lvl <$> asks envNumbering
return $ ListItem parstyle numId lvl levelInfo parparts
elemToBodyPart ns element
| isElem ns "w" "p" element = do
sty <- asks envParStyles
let parstyle = elemToParagraphStyle ns element sty
parstyle <- elemToParagraphStyle ns element <$> asks envParStyles
parparts <- mapD (elemToParPart ns) (elChildren element)
-- Word uses list enumeration for numbered headings, so we only
-- want to infer a list from the styles if it is NOT a heading.
case pHeading parstyle of
Nothing | Just (numId, lvl) <- pNumInfo parstyle -> do
num <- asks envNumbering
let levelInfo = lookupLevel numId lvl num
levelInfo <- lookupLevel numId lvl <$> asks envNumbering
return $ ListItem parstyle numId lvl levelInfo parparts
_ -> return $ Paragraph parstyle parparts
elemToBodyPart ns element
@ -727,7 +723,7 @@ elemToBodyPart ns element
let caption' = findChildByName ns "w" "tblPr" element
>>= findChildByName ns "w" "tblCaption"
>>= findAttrByName ns "w" "val"
caption = (fromMaybe "" caption')
caption = fromMaybe "" caption'
grid' = case findChildByName ns "w" "tblGrid" element of
Just g -> elemToTblGrid ns g
Nothing -> return []