diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 70 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx/Parse.hs | 32 |
2 files changed, 39 insertions, 63 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 4f44d18e7..a26986af2 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -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. diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index f725660b9..330c9208f 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -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 [] |