fd14ad5 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

[Docx Reader] Code clean-up

fd14ad5Nikolay Yakimov7 years ago

src/Text/Pandoc/Readers/Docx.hs+25−45

compare with master

unifiedsplit

@@ -2,6 +2,7 @@

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE PatternGuards #-}

5+{-# LANGUAGE MultiWayIf #-}

5{- |

6{- |

6 Module : Text.Pandoc.Readers.Docx

7 Module : Text.Pandoc.Readers.Docx

@@ -129,7 +130,7 @@ instance Default DEnv where

129type DocxContext m = ReaderT DEnv (StateT DState m)

130type DocxContext m = ReaderT DEnv (StateT DState m)

130

131

131evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a

132evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a

132−evalDocxContext ctx env st = flip evalStateT st $flip runReaderT env ctx

133+evalDocxContext ctx env st = flip evalStateT st $ runReaderT ctx env

133

134

134-- This is empty, but we put it in for future-proofing.

135-- This is empty, but we put it in for future-proofing.

135spansToKeep :: [String]

136spansToKeep :: [String]

@@ -537,15 +538,6 @@ parStyleToTransform pPr

537 let pPr' = pPr { pStyle = cs, indentation = Nothing}

538 let pPr' = pPr { pStyle = cs, indentation = Nothing}

538 transform <- parStyleToTransform pPr'

539 transform <- parStyleToTransform pPr'

539 return $ divWith ("", [c], []) . transform

540 return $ divWith ("", [c], []) . transform

540− | (c:cs) <- pStyle pPr

541− , Just True <- pBlockQuote pPr = do

542− opts <- asks docxOptions

543− let pPr' = pPr { pStyle = cs }

544− transform <- parStyleToTransform pPr'

545− let extraInfo = if isEnabled Ext_styles opts

546− then divWith ("", [], [("custom-style", c)])

547− else id

548− return $ extraInfo . blockQuote . transform

549 | (c:cs) <- pStyle pPr = do

541 | (c:cs) <- pStyle pPr = do

550 opts <- asks docxOptions

542 opts <- asks docxOptions

551 let pPr' = pPr { pStyle = cs}

543 let pPr' = pPr { pStyle = cs}

@@ -553,22 +545,15 @@ parStyleToTransform pPr

553 let extraInfo = if isEnabled Ext_styles opts

545 let extraInfo = if isEnabled Ext_styles opts

554 then divWith ("", [], [("custom-style", c)])

546 then divWith ("", [], [("custom-style", c)])

555 else id

547 else id

556− return $ extraInfo . transform

548+ return $ extraInfo . (if fromMaybe False (pBlockQuote pPr) then blockQuote else id) . transform

557 | null (pStyle pPr)

549 | null (pStyle pPr)

558− , Just left <- indentation pPr >>= leftParIndent

550+ , Just left <- indentation pPr >>= leftParIndent = do

559− , Just hang <- indentation pPr >>= hangingParIndent = do

560 let pPr' = pPr { indentation = Nothing }

551 let pPr' = pPr { indentation = Nothing }

552+ hang = fromMaybe 0 $ indentation pPr >>= hangingParIndent

561 transform <- parStyleToTransform pPr'

553 transform <- parStyleToTransform pPr'

562− return $ case (left - hang) > 0 of

554+ return $ if (left - hang) > 0

563− True -> blockQuote . transform

564− False -> transform

565− | null (pStyle pPr),

566− Just left <- indentation pPr >>= leftParIndent = do

567− let pPr' = pPr { indentation = Nothing }

568− transform <- parStyleToTransform pPr'

569− return $ case left > 0 of

570− True -> blockQuote . transform

555+ then blockQuote . transform

571− False -> transform

556+ else transform

572parStyleToTransform _ = return id

557parStyleToTransform _ = return id

573

558

574bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks

559bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks

@@ -585,7 +570,7 @@ bodyPartToBlocks (Paragraph pPr parparts)

585 makeHeaderAnchor $

570 makeHeaderAnchor $

586 headerWith ("", delete style (pStyle pPr), []) n ils

571 headerWith ("", delete style (pStyle pPr), []) n ils

587 | otherwise = do

572 | otherwise = do

588− ils <- (trimSps . smushInlines) <$> mapM parPartToInlines parparts

573+ ils <- trimSps . smushInlines <$> mapM parPartToInlines parparts

589 prevParaIls <- gets docxPrevPara

574 prevParaIls <- gets docxPrevPara

590 dropIls <- gets docxDropCap

575 dropIls <- gets docxDropCap

591 let ils' = dropIls <> ils

576 let ils' = dropIls <> ils

@@ -596,21 +581,21 @@ bodyPartToBlocks (Paragraph pPr parparts)

596 let ils'' = prevParaIls <>

581 let ils'' = prevParaIls <>

597 (if isNull prevParaIls then mempty else space) <>

582 (if isNull prevParaIls then mempty else space) <>

598 ils'

583 ils'

584+ handleInsertion = do

585+ modify $ \s -> s {docxPrevPara = mempty}

586+ transform <- parStyleToTransform pPr

587+ return $ transform $ para ils''

599 opts <- asks docxOptions

588 opts <- asks docxOptions

600− case () of

601−

602− _ | isNull ils'' && not (isEnabled Ext_empty_paragraphs opts) ->

589+ if | isNull ils'' && not (isEnabled Ext_empty_paragraphs opts) ->

603 return mempty

590 return mempty

604− _ | Just (TrackedChange Insertion _) <- pChange pPr

591+ | Just (TrackedChange Insertion _) <- pChange pPr

605− , AcceptChanges <- readerTrackChanges opts -> do

592+ , AcceptChanges <- readerTrackChanges opts ->

606− modify $ \s -> s {docxPrevPara = mempty}

593+ handleInsertion

607− transform <- parStyleToTransform pPr

608− return $ transform $ para ils''

609− _ | Just (TrackedChange Insertion _) <- pChange pPr

594+ | Just (TrackedChange Insertion _) <- pChange pPr

610 , RejectChanges <- readerTrackChanges opts -> do

595 , RejectChanges <- readerTrackChanges opts -> do

611 modify $ \s -> s {docxPrevPara = ils''}

596 modify $ \s -> s {docxPrevPara = ils''}

612 return mempty

597 return mempty

613− _ | Just (TrackedChange Insertion cInfo) <- pChange pPr

598+ | Just (TrackedChange Insertion cInfo) <- pChange pPr

614 , AllChanges <- readerTrackChanges opts

599 , AllChanges <- readerTrackChanges opts

615 , ChangeInfo _ cAuthor cDate <- cInfo -> do

600 , ChangeInfo _ cAuthor cDate <- cInfo -> do

616 let attr = ("", ["paragraph-insertion"], [("author", cAuthor), ("date", cDate)])

601 let attr = ("", ["paragraph-insertion"], [("author", cAuthor), ("date", cDate)])

@@ -618,16 +603,14 @@ bodyPartToBlocks (Paragraph pPr parparts)

618 transform <- parStyleToTransform pPr

603 transform <- parStyleToTransform pPr

619 return $ transform $

604 return $ transform $

620 para $ ils'' <> insertMark

605 para $ ils'' <> insertMark

621− _ | Just (TrackedChange Deletion _) <- pChange pPr

606+ | Just (TrackedChange Deletion _) <- pChange pPr

622 , AcceptChanges <- readerTrackChanges opts -> do

607 , AcceptChanges <- readerTrackChanges opts -> do

623 modify $ \s -> s {docxPrevPara = ils''}

608 modify $ \s -> s {docxPrevPara = ils''}

624 return mempty

609 return mempty

625− _ | Just (TrackedChange Deletion _) <- pChange pPr

610+ | Just (TrackedChange Deletion _) <- pChange pPr

626− , RejectChanges <- readerTrackChanges opts -> do

611+ , RejectChanges <- readerTrackChanges opts ->

627− modify $ \s -> s {docxPrevPara = mempty}

612+ handleInsertion

628− transform <- parStyleToTransform pPr

629− return $ transform $ para ils''

630− _ | Just (TrackedChange Deletion cInfo) <- pChange pPr

613+ | Just (TrackedChange Deletion cInfo) <- pChange pPr

631 , AllChanges <- readerTrackChanges opts

614 , AllChanges <- readerTrackChanges opts

632 , ChangeInfo _ cAuthor cDate <- cInfo -> do

615 , ChangeInfo _ cAuthor cDate <- cInfo -> do

633 let attr = ("", ["paragraph-deletion"], [("author", cAuthor), ("date", cDate)])

616 let attr = ("", ["paragraph-deletion"], [("author", cAuthor), ("date", cDate)])

@@ -635,10 +618,7 @@ bodyPartToBlocks (Paragraph pPr parparts)

635 transform <- parStyleToTransform pPr

618 transform <- parStyleToTransform pPr

636 return $ transform $

619 return $ transform $

637 para $ ils'' <> insertMark

620 para $ ils'' <> insertMark

638− _ | otherwise -> do

621+ | otherwise -> handleInsertion

639− modify $ \s -> s {docxPrevPara = mempty}

640− transform <- parStyleToTransform pPr

641− return $ transform $ para ils''

642bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do

622bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do

643 -- We check whether this current numId has previously been used,

623 -- We check whether this current numId has previously been used,

644 -- since Docx expects us to pick up where we left off.

624 -- since Docx expects us to pick up where we left off.

src/Text/Pandoc/Readers/Docx/Parse.hs+14−18

@@ -121,9 +121,9 @@ unwrap :: NameSpaces -> Content -> [Content]

121unwrap ns (Elem element)

122 | isElem ns "w" "sdt" element

123 , Just sdtContent <- findChildByName ns "w" "sdtContent" element

124− = concatMap ((unwrap ns) . Elem) (elChildren sdtContent)

124+ = concatMap (unwrap ns . Elem) (elChildren sdtContent)

125 | isElem ns "w" "smartTag" element

126− = concatMap ((unwrap ns) . Elem) (elChildren element)

126+ = concatMap (unwrap ns . Elem) (elChildren element)

127unwrap _ content = [content]

128

129unwrapChild :: NameSpaces -> Content -> Content

@@ -149,13 +149,13 @@ walkDocument ns element =

149 _ -> Nothing

150

151

152−data Docx = Docx Document

152+newtype Docx = Docx Document

153 deriving Show

154

155data Document = Document NameSpaces Body

156 deriving Show

157

158−data Body = Body [BodyPart]

158+newtype Body = Body [BodyPart]

159 deriving Show

160

161type Media = [(FilePath, B.ByteString)]

@@ -242,16 +242,16 @@ data BodyPart = Paragraph ParagraphStyle [ParPart]

242

243type TblGrid = [Integer]

244

245−data TblLook = TblLook {firstRowFormatting::Bool}

245+newtype TblLook = TblLook {firstRowFormatting::Bool}

246 deriving Show

247

248defaultTblLook :: TblLook

249defaultTblLook = TblLook{firstRowFormatting = False}

250

251−data Row = Row [Cell]

251+newtype Row = Row [Cell]

252 deriving Show

253

254−data Cell = Cell [BodyPart]

254+newtype Cell = Cell [BodyPart]

255 deriving Show

256

257-- (width, height) in EMUs

@@ -495,7 +495,7 @@ filePathToRelType "word/_rels/endnotes.xml.rels" _ = Just InEndnote

495-- -- to see if it's a documentPath, we have to check against the dynamic

496-- -- docPath specified in "_rels/.rels"

497filePathToRelType path docXmlPath =

498− if path == "word/_rels/" ++ (takeFileName docXmlPath) ++ ".rels"

498+ if path == "word/_rels/" ++ takeFileName docXmlPath ++ ".rels"

499 then Just InDocument

500 else Nothing

501

@@ -537,7 +537,7 @@ lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do

537 case lvlOverride of

538 Just (LevelOverride _ _ (Just lvl')) -> Just lvl'

539 Just (LevelOverride _ (Just strt) _) ->

540− lookup ilvl $ map (\(Level i fmt s _) -> (i, (Level i fmt s (Just strt)))) lvls

540+ lookup ilvl $ map (\(Level i fmt s _) -> (i, Level i fmt s (Just strt))) lvls

541 _ ->

542 lookup ilvl $ map (\l@(Level i _ _ _) -> (i, l)) lvls

543

@@ -703,23 +703,19 @@ elemToBodyPart ns element

703elemToBodyPart ns element

704 | isElem ns "w" "p" element

705 , Just (numId, lvl) <- getNumInfo ns element = do

706− sty <- asks envParStyles

707− let parstyle = elemToParagraphStyle ns element sty

706+ parstyle <- elemToParagraphStyle ns element <$> asks envParStyles

708 parparts <- mapD (elemToParPart ns) (elChildren element)

707 parparts <- mapD (elemToParPart ns) (elChildren element)

709− num <- asks envNumbering

710− let levelInfo = lookupLevel numId lvl num

708+ levelInfo <- lookupLevel numId lvl <$> asks envNumbering

711 return $ ListItem parstyle numId lvl levelInfo parparts

709 return $ ListItem parstyle numId lvl levelInfo parparts

712elemToBodyPart ns element

710elemToBodyPart ns element

713 | isElem ns "w" "p" element = do

711 | isElem ns "w" "p" element = do

714− sty <- asks envParStyles

715− let parstyle = elemToParagraphStyle ns element sty

712+ parstyle <- elemToParagraphStyle ns element <$> asks envParStyles

716 parparts <- mapD (elemToParPart ns) (elChildren element)

713 parparts <- mapD (elemToParPart ns) (elChildren element)

717 -- Word uses list enumeration for numbered headings, so we only

714 -- Word uses list enumeration for numbered headings, so we only

718 -- want to infer a list from the styles if it is NOT a heading.

715 -- want to infer a list from the styles if it is NOT a heading.

719 case pHeading parstyle of

716 case pHeading parstyle of

720 Nothing | Just (numId, lvl) <- pNumInfo parstyle -> do

717 Nothing | Just (numId, lvl) <- pNumInfo parstyle -> do

721− num <- asks envNumbering

722− let levelInfo = lookupLevel numId lvl num

718+ levelInfo <- lookupLevel numId lvl <$> asks envNumbering

723 return $ ListItem parstyle numId lvl levelInfo parparts

719 return $ ListItem parstyle numId lvl levelInfo parparts

724 _ -> return $ Paragraph parstyle parparts

720 _ -> return $ Paragraph parstyle parparts

725elemToBodyPart ns element

721elemToBodyPart ns element

@@ -727,7 +723,7 @@ elemToBodyPart ns element

727 let caption' = findChildByName ns "w" "tblPr" element

723 let caption' = findChildByName ns "w" "tblPr" element

728 >>= findChildByName ns "w" "tblCaption"

724 >>= findChildByName ns "w" "tblCaption"

729 >>= findAttrByName ns "w" "val"

725 >>= findAttrByName ns "w" "val"

730− caption = (fromMaybe "" caption')

726+ caption = fromMaybe "" caption'

731 grid' = case findChildByName ns "w" "tblGrid" element of

727 grid' = case findChildByName ns "w" "tblGrid" element of

732 Just g -> elemToTblGrid ns g

728 Just g -> elemToTblGrid ns g

733 Nothing -> return []

729 Nothing -> return []