git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: handle local namespace declarations.

Previously we didn't recognize math, for example, when the xmlns declaration occured on the element and not the root. Now we recognize either. Closes #3365. This patch defines findChildByName, findChildrenByName, and findAttrByName in Util, and uses these in Parse.

commit76aa43c579cf9662143d2f145cc44f3a094d139a authorJohn MacFarlane <jgm@berkeley.edu> dateFri 3 Feb 2017, 22:23 (10 years ago) parented4f84e
2 files changed+127−107
src/Text/Pandoc/Readers/Docx/Parse.hs+105−105 src/Text/Pandoc/Readers/Docx/Util.hs+22−2
src/Text/Pandoc/Readers/Docx/Parse.hs+105−105
@@ -295,7 +295,7 @@ archiveToDocument zf = do
295295 entry <- maybeToD $ findEntryByPath "word/document.xml" zf
296296 docElem <- maybeToD $ (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
297297 let namespaces = elemToNameSpaces docElem
298− bodyElem <- maybeToD $ findChild (elemName namespaces "w" "body") docElem
298+ bodyElem <- maybeToD $ findChildByName namespaces "w" "body" docElem
299299 body <- elemToBody namespaces bodyElem
300300 return $ Document namespaces body
301301
@@ -323,15 +323,15 @@ archiveToStyles zf =
323323isBasedOnStyle :: (ElemToStyle a) => NameSpaces -> Element -> Maybe a -> Bool
324324isBasedOnStyle ns element parentStyle
325325 | isElem ns "w" "style" element
326− , Just styleType <- findAttr (elemName ns "w" "type") element
326+ , Just styleType <- findAttrByName ns "w" "type" element
327327 , styleType == cStyleType parentStyle
328− , Just basedOnVal <- findChild (elemName ns "w" "basedOn") element >>=
329− findAttr (elemName ns "w" "val")
328+ , Just basedOnVal <- findChildByName ns "w" "basedOn" element >>=
329+ findAttrByName ns "w" "val"
330330 , Just ps <- parentStyle = (basedOnVal == getStyleId ps)
331331 | isElem ns "w" "style" element
332− , Just styleType <- findAttr (elemName ns "w" "type") element
332+ , Just styleType <- findAttrByName ns "w" "type" element
333333 , styleType == cStyleType parentStyle
334− , Nothing <- findChild (elemName ns "w" "basedOn") element
334+ , Nothing <- findChildByName ns "w" "basedOn" element
335335 , Nothing <- parentStyle = True
336336 | otherwise = False
337337
@@ -344,8 +344,8 @@ instance ElemToStyle CharStyle where
344344 cStyleType _ = "character"
345345 elemToStyle ns element parentStyle
346346 | isElem ns "w" "style" element
347− , Just "character" <- findAttr (elemName ns "w" "type") element
348− , Just styleId <- findAttr (elemName ns "w" "styleId") element =
347+ , Just "character" <- findAttrByName ns "w" "type" element
348+ , Just styleId <- findAttrByName ns "w" "styleId" element =
349349 Just (styleId, elemToRunStyle ns element parentStyle)
350350 | otherwise = Nothing
351351 getStyleId s = fst s
@@ -354,8 +354,8 @@ instance ElemToStyle ParStyle where
354354 cStyleType _ = "paragraph"
355355 elemToStyle ns element parentStyle
356356 | isElem ns "w" "style" element
357− , Just "paragraph" <- findAttr (elemName ns "w" "type") element
358− , Just styleId <- findAttr (elemName ns "w" "styleId") element =
357+ , Just "paragraph" <- findAttrByName ns "w" "type" element
358+ , Just styleId <- findAttrByName ns "w" "styleId" element =
359359 Just (styleId, elemToParStyleData ns element parentStyle)
360360 | otherwise = Nothing
361361 getStyleId s = fst s
@@ -447,17 +447,17 @@ lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
447447numElemToNum :: NameSpaces -> Element -> Maybe Numb
448448numElemToNum ns element
449449 | isElem ns "w" "num" element = do
450− numId <- findAttr (elemName ns "w" "numId") element
451− absNumId <- findChild (elemName ns "w" "abstractNumId") element
452− >>= findAttr (elemName ns "w" "val")
450+ numId <- findAttrByName ns "w" "numId" element
451+ absNumId <- findChildByName ns "w" "abstractNumId" element
452+ >>= findAttrByName ns "w" "val"
453453 return $ Numb numId absNumId
454454numElemToNum _ _ = Nothing
455455
456456absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
457457absNumElemToAbsNum ns element
458458 | isElem ns "w" "abstractNum" element = do
459− absNumId <- findAttr (elemName ns "w" "abstractNumId") element
460− let levelElems = findChildren (elemName ns "w" "lvl") element
459+ absNumId <- findAttrByName ns "w" "abstractNumId" element
460+ let levelElems = findChildrenByName ns "w" "lvl" element
461461 levels = mapMaybe (levelElemToLevel ns) levelElems
462462 return $ AbstractNumb absNumId levels
463463absNumElemToAbsNum _ _ = Nothing
@@ -465,13 +465,13 @@ absNumElemToAbsNum _ _ = Nothing
465465levelElemToLevel :: NameSpaces -> Element -> Maybe Level
466466levelElemToLevel ns element
467467 | isElem ns "w" "lvl" element = do
468− ilvl <- findAttr (elemName ns "w" "ilvl") element
469− fmt <- findChild (elemName ns "w" "numFmt") element
470− >>= findAttr (elemName ns "w" "val")
471− txt <- findChild (elemName ns "w" "lvlText") element
472− >>= findAttr (elemName ns "w" "val")
473− let start = findChild (elemName ns "w" "start") element
474− >>= findAttr (elemName ns "w" "val")
468+ ilvl <- findAttrByName ns "w" "ilvl" element
469+ fmt <- findChildByName ns "w" "numFmt" element
470+ >>= findAttrByName ns "w" "val"
471+ txt <- findChildByName ns "w" "lvlText" element
472+ >>= findAttrByName ns "w" "val"
473+ let start = findChildByName ns "w" "start" element
474+ >>= findAttrByName ns "w" "val"
475475 >>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)])))
476476 return (ilvl, fmt, txt, start)
477477levelElemToLevel _ _ = Nothing
@@ -483,8 +483,8 @@ archiveToNumbering' zf = do
483483 Just entry -> do
484484 numberingElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry
485485 let namespaces = elemToNameSpaces numberingElem
486− numElems = findChildren (elemName namespaces "w" "num") numberingElem
487− absNumElems = findChildren (elemName namespaces "w" "abstractNum") numberingElem
486+ numElems = findChildrenByName namespaces "w" "num" numberingElem
487+ absNumElems = findChildrenByName namespaces "w" "abstractNum" numberingElem
488488 nums = mapMaybe (numElemToNum namespaces) numElems
489489 absNums = mapMaybe (absNumElemToAbsNum namespaces) absNumElems
490490 return $ Numbering namespaces nums absNums
@@ -497,9 +497,9 @@ elemToNotes :: NameSpaces -> String -> Element -> Maybe (M.Map String Element)
497497elemToNotes ns notetype element
498498 | isElem ns "w" (notetype ++ "s") element =
499499 let pairs = mapMaybe
500− (\e -> findAttr (elemName ns "w" "id") e >>=
500+ (\e -> findAttrByName ns "w" "id" e >>=
501501 (\a -> Just (a, e)))
502− (findChildren (elemName ns "w" notetype) element)
502+ (findChildrenByName ns "w" notetype element)
503503 in
504504 Just $ M.fromList $ pairs
505505elemToNotes _ _ _ = Nothing
@@ -508,9 +508,9 @@ elemToComments :: NameSpaces -> Element -> M.Map String Element
508508elemToComments ns element
509509 | isElem ns "w" "comments" element =
510510 let pairs = mapMaybe
511− (\e -> findAttr (elemName ns "w" "id") e >>=
511+ (\e -> findAttrByName ns "w" "id" e >>=
512512 (\a -> Just (a, e)))
513− (findChildren (elemName ns "w" "comment") element)
513+ (findChildrenByName ns "w" "comment" element)
514514 in
515515 M.fromList $ pairs
516516elemToComments _ _ = M.empty
@@ -521,16 +521,16 @@ elemToComments _ _ = M.empty
521521
522522elemToTblGrid :: NameSpaces -> Element -> D TblGrid
523523elemToTblGrid ns element | isElem ns "w" "tblGrid" element =
524− let cols = findChildren (elemName ns "w" "gridCol") element
524+ let cols = findChildrenByName ns "w" "gridCol" element
525525 in
526− mapD (\e -> maybeToD (findAttr (elemName ns "w" "val") e >>= stringToInteger))
526+ mapD (\e -> maybeToD (findAttrByName ns "w" "val" e >>= stringToInteger))
527527 cols
528528elemToTblGrid _ _ = throwError WrongElem
529529
530530elemToTblLook :: NameSpaces -> Element -> D TblLook
531531elemToTblLook ns element | isElem ns "w" "tblLook" element =
532− let firstRow = findAttr (elemName ns "w" "firstRow") element
533− val = findAttr (elemName ns "w" "val") element
532+ let firstRow = findAttrByName ns "w" "firstRow" element
533+ val = findAttrByName ns "w" "val" element
534534 firstRowFmt =
535535 case firstRow of
536536 Just "1" -> True
@@ -545,7 +545,7 @@ elemToTblLook _ _ = throwError WrongElem
545545elemToRow :: NameSpaces -> Element -> D Row
546546elemToRow ns element | isElem ns "w" "tr" element =
547547 do
548− let cellElems = findChildren (elemName ns "w" "tc") element
548+ let cellElems = findChildrenByName ns "w" "tc" element
549549 cells <- mapD (elemToCell ns) cellElems
550550 return $ Row cells
551551elemToRow _ _ = throwError WrongElem
@@ -561,13 +561,13 @@ elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
561561elemToParIndentation ns element | isElem ns "w" "ind" element =
562562 Just $ ParIndentation {
563563 leftParIndent =
564− findAttr (elemName ns "w" "left") element >>=
564+ findAttrByName ns "w" "left" element >>=
565565 stringToInteger
566566 , rightParIndent =
567− findAttr (elemName ns "w" "right") element >>=
567+ findAttrByName ns "w" "right" element >>=
568568 stringToInteger
569569 , hangingParIndent =
570− findAttr (elemName ns "w" "hanging") element >>=
570+ findAttrByName ns "w" "hanging" element >>=
571571 stringToInteger}
572572elemToParIndentation _ _ = Nothing
573573
@@ -583,7 +583,7 @@ stringToInteger s = listToMaybe $ map fst (reads s :: [(Integer, String)])
583583elemToBodyPart :: NameSpaces -> Element -> D BodyPart
584584elemToBodyPart ns element
585585 | isElem ns "w" "p" element
586− , (c:_) <- findChildren (elemName ns "m" "oMathPara") element =
586+ , (c:_) <- findChildrenByName ns "m" "oMathPara" element =
587587 do
588588 expsLst <- eitherToD $ readOMML $ showElement c
589589 return $ OMathPara expsLst
@@ -611,15 +611,15 @@ elemToBodyPart ns element
611611 _ -> return $ Paragraph parstyle parparts
612612elemToBodyPart ns element
613613 | isElem ns "w" "tbl" element = do
614− let caption' = findChild (elemName ns "w" "tblPr") element
615− >>= findChild (elemName ns "w" "tblCaption")
616− >>= findAttr (elemName ns "w" "val")
614+ let caption' = findChildByName ns "w" "tblPr" element
615+ >>= findChildByName ns "w" "tblCaption"
616+ >>= findAttrByName ns "w" "val"
617617 caption = (fromMaybe "" caption')
618− grid' = case findChild (elemName ns "w" "tblGrid") element of
618+ grid' = case findChildByName ns "w" "tblGrid" element of
619619 Just g -> elemToTblGrid ns g
620620 Nothing -> return []
621− tblLook' = case findChild (elemName ns "w" "tblPr") element >>=
622− findChild (elemName ns "w" "tblLook")
621+ tblLook' = case findChildByName ns "w" "tblPr" element >>=
622+ findChildByName ns "w" "tblLook"
623623 of
624624 Just l -> elemToTblLook ns l
625625 Nothing -> return defaultTblLook
@@ -650,12 +650,12 @@ expandDrawingId s = do
650650
651651getTitleAndAlt :: NameSpaces -> Element -> (String, String)
652652getTitleAndAlt ns element =
653− let mbDocPr = findChild (elemName ns "wp" "inline") element >>=
654− findChild (elemName ns "wp" "docPr")
655− title = case mbDocPr >>= findAttr (elemName ns "" "title") of
653+ let mbDocPr = findChildByName ns "wp" "inline" element >>=
654+ findChildByName ns "wp" "docPr"
655+ title = case mbDocPr >>= findAttrByName ns "" "title" of
656656 Just title' -> title'
657657 Nothing -> ""
658− alt = case mbDocPr >>= findAttr (elemName ns "" "descr") of
658+ alt = case mbDocPr >>= findAttrByName ns "" "descr" of
659659 Just alt' -> alt'
660660 Nothing -> ""
661661 in (title, alt)
@@ -663,13 +663,13 @@ getTitleAndAlt ns element =
663663elemToParPart :: NameSpaces -> Element -> D ParPart
664664elemToParPart ns element
665665 | isElem ns "w" "r" element
666− , Just drawingElem <- findChild (elemName ns "w" "drawing") element
666+ , Just drawingElem <- findChildByName ns "w" "drawing" element
667667 , pic_ns <- "http://schemas.openxmlformats.org/drawingml/2006/picture"
668668 , Just picElem <- findElement (QName "pic" (Just pic_ns) (Just "pic")) drawingElem
669669 = let (title, alt) = getTitleAndAlt ns drawingElem
670670 a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
671671 drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem
672− >>= findAttr (elemName ns "r" "embed")
672+ >>= findAttrByName ns "r" "embed"
673673 in
674674 case drawing of
675675 Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp title alt bs $ elemToExtent drawingElem)
@@ -677,9 +677,9 @@ elemToParPart ns element
677677-- The below is an attempt to deal with images in deprecated vml format.
678678elemToParPart ns element
679679 | isElem ns "w" "r" element
680− , Just _ <- findChild (elemName ns "w" "pict") element =
680+ , Just _ <- findChildByName ns "w" "pict" element =
681681 let drawing = findElement (elemName ns "v" "imagedata") element
682− >>= findAttr (elemName ns "r" "id")
682+ >>= findAttrByName ns "r" "id"
683683 in
684684 case drawing of
685685 -- Todo: check out title and attr for deprecated format.
@@ -688,7 +688,7 @@ elemToParPart ns element
688688-- Chart
689689elemToParPart ns element
690690 | isElem ns "w" "r" element
691− , Just drawingElem <- findChild (elemName ns "w" "drawing") element
691+ , Just drawingElem <- findChildByName ns "w" "drawing" element
692692 , c_ns <- "http://schemas.openxmlformats.org/drawingml/2006/chart"
693693 , Just _ <- findElement (QName "chart" (Just c_ns) (Just "c")) drawingElem
694694 = return Chart
@@ -697,16 +697,16 @@ elemToParPart ns element
697697 elemToRun ns element >>= (\r -> return $ PlainRun r)
698698elemToParPart ns element
699699 | isElem ns "w" "ins" element || isElem ns "w" "moveTo" element
700− , Just cId <- findAttr (elemName ns "w" "id") element
701− , Just cAuthor <- findAttr (elemName ns "w" "author") element
702− , Just cDate <- findAttr (elemName ns "w" "date") element = do
700+ , Just cId <- findAttrByName ns "w" "id" element
701+ , Just cAuthor <- findAttrByName ns "w" "author" element
702+ , Just cDate <- findAttrByName ns "w" "date" element = do
703703 runs <- mapD (elemToRun ns) (elChildren element)
704704 return $ Insertion cId cAuthor cDate runs
705705elemToParPart ns element
706706 | isElem ns "w" "del" element || isElem ns "w" "moveFrom" element
707− , Just cId <- findAttr (elemName ns "w" "id") element
708− , Just cAuthor <- findAttr (elemName ns "w" "author") element
709− , Just cDate <- findAttr (elemName ns "w" "date") element = do
707+ , Just cId <- findAttrByName ns "w" "id" element
708+ , Just cAuthor <- findAttrByName ns "w" "author" element
709+ , Just cDate <- findAttrByName ns "w" "date" element = do
710710 runs <- mapD (elemToRun ns) (elChildren element)
711711 return $ Deletion cId cAuthor cDate runs
712712elemToParPart ns element
@@ -715,36 +715,36 @@ elemToParPart ns element
715715 return $ SmartTag runs
716716elemToParPart ns element
717717 | isElem ns "w" "bookmarkStart" element
718− , Just bmId <- findAttr (elemName ns "w" "id") element
719− , Just bmName <- findAttr (elemName ns "w" "name") element =
718+ , Just bmId <- findAttrByName ns "w" "id" element
719+ , Just bmName <- findAttrByName ns "w" "name" element =
720720 return $ BookMark bmId bmName
721721elemToParPart ns element
722722 | isElem ns "w" "hyperlink" element
723− , Just relId <- findAttr (elemName ns "r" "id") element = do
723+ , Just relId <- findAttrByName ns "r" "id" element = do
724724 location <- asks envLocation
725725 runs <- mapD (elemToRun ns) (elChildren element)
726726 rels <- asks envRelationships
727727 case lookupRelationship location relId rels of
728728 Just target -> do
729− case findAttr (elemName ns "w" "anchor") element of
729+ case findAttrByName ns "w" "anchor" element of
730730 Just anchor -> return $ ExternalHyperLink (target ++ '#':anchor) runs
731731 Nothing -> return $ ExternalHyperLink target runs
732732 Nothing -> return $ ExternalHyperLink "" runs
733733elemToParPart ns element
734734 | isElem ns "w" "hyperlink" element
735− , Just anchor <- findAttr (elemName ns "w" "anchor") element = do
735+ , Just anchor <- findAttrByName ns "w" "anchor" element = do
736736 runs <- mapD (elemToRun ns) (elChildren element)
737737 return $ InternalHyperLink anchor runs
738738elemToParPart ns element
739739 | isElem ns "w" "commentRangeStart" element
740− , Just cmtId <- findAttr (elemName ns "w" "id") element = do
740+ , Just cmtId <- findAttrByName ns "w" "id" element = do
741741 (Comments _ commentMap) <- asks envComments
742742 case M.lookup cmtId commentMap of
743743 Just cmtElem -> elemToCommentStart ns cmtElem
744744 Nothing -> throwError WrongElem
745745elemToParPart ns element
746746 | isElem ns "w" "commentRangeEnd" element
747− , Just cmtId <- findAttr (elemName ns "w" "id") element =
747+ , Just cmtId <- findAttrByName ns "w" "id" element =
748748 return $ CommentEnd cmtId
749749elemToParPart ns element
750750 | isElem ns "m" "oMath" element =
@@ -754,9 +754,9 @@ elemToParPart _ _ = throwError WrongElem
754754elemToCommentStart :: NameSpaces -> Element -> D ParPart
755755elemToCommentStart ns element
756756 | isElem ns "w" "comment" element
757− , Just cmtId <- findAttr (elemName ns "w" "id") element
758− , Just cmtAuthor <- findAttr (elemName ns "w" "author") element
759− , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
757+ , Just cmtId <- findAttrByName ns "w" "id" element
758+ , Just cmtAuthor <- findAttrByName ns "w" "author" element
759+ , Just cmtDate <- findAttrByName ns "w" "date" element = do
760760 bps <- mapD (elemToBodyPart ns) (elChildren element)
761761 return $ CommentStart cmtId cmtAuthor cmtDate bps
762762elemToCommentStart _ _ = throwError WrongElem
@@ -799,7 +799,7 @@ childElemToRun ns element
799799 = return InlineChart
800800childElemToRun ns element
801801 | isElem ns "w" "footnoteReference" element
802− , Just fnId <- findAttr (elemName ns "w" "id") element = do
802+ , Just fnId <- findAttrByName ns "w" "id" element = do
803803 notes <- asks envNotes
804804 case lookupFootnote fnId notes of
805805 Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e)
@@ -807,7 +807,7 @@ childElemToRun ns element
807807 Nothing -> return $ Footnote []
808808childElemToRun ns element
809809 | isElem ns "w" "endnoteReference" element
810− , Just enId <- findAttr (elemName ns "w" "id") element = do
810+ , Just enId <- findAttrByName ns "w" "id" element = do
811811 notes <- asks envNotes
812812 case lookupEndnote enId notes of
813813 Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e)
@@ -818,8 +818,8 @@ childElemToRun _ _ = throwError WrongElem
818818elemToRun :: NameSpaces -> Element -> D Run
819819elemToRun ns element
820820 | isElem ns "w" "r" element
821− , Just altCont <- findChild (elemName ns "mc" "AlternateContent") element =
822− do let choices = findChildren (elemName ns "mc" "Choice") altCont
821+ , Just altCont <- findChildByName ns "mc" "AlternateContent" element =
822+ do let choices = findChildrenByName ns "mc" "Choice" altCont
823823 choiceChildren = map head $ filter (not . null) $ map elChildren choices
824824 outputs <- mapD (childElemToRun ns) choiceChildren
825825 case outputs of
@@ -827,15 +827,15 @@ elemToRun ns element
827827 [] -> throwError WrongElem
828828elemToRun ns element
829829 | isElem ns "w" "r" element
830− , Just drawingElem <- findChild (elemName ns "w" "drawing") element =
830+ , Just drawingElem <- findChildByName ns "w" "drawing" element =
831831 childElemToRun ns drawingElem
832832elemToRun ns element
833833 | isElem ns "w" "r" element
834− , Just ref <- findChild (elemName ns "w" "footnoteReference") element =
834+ , Just ref <- findChildByName ns "w" "footnoteReference" element =
835835 childElemToRun ns ref
836836elemToRun ns element
837837 | isElem ns "w" "r" element
838− , Just ref <- findChild (elemName ns "w" "endnoteReference") element =
838+ , Just ref <- findChildByName ns "w" "endnoteReference" element =
839839 childElemToRun ns ref
840840elemToRun ns element
841841 | isElem ns "w" "r" element = do
@@ -861,20 +861,20 @@ getParStyleField _ _ _ = Nothing
861861
862862elemToParagraphStyle :: NameSpaces -> Element -> ParStyleMap -> ParagraphStyle
863863elemToParagraphStyle ns element sty
864− | Just pPr <- findChild (elemName ns "w" "pPr") element =
864+ | Just pPr <- findChildByName ns "w" "pPr" element =
865865 let style =
866866 mapMaybe
867− (findAttr (elemName ns "w" "val"))
868− (findChildren (elemName ns "w" "pStyle") pPr)
867+ (findAttrByName ns "w" "val")
868+ (findChildrenByName ns "w" "pStyle" pPr)
869869 in ParagraphStyle
870870 {pStyle = style
871871 , indentation =
872− findChild (elemName ns "w" "ind") pPr >>=
872+ findChildByName ns "w" "ind" pPr >>=
873873 elemToParIndentation ns
874874 , dropCap =
875875 case
876− findChild (elemName ns "w" "framePr") pPr >>=
877− findAttr (elemName ns "w" "dropCap")
876+ findChildByName ns "w" "framePr" pPr >>=
877+ findAttrByName ns "w" "dropCap"
878878 of
879879 Just "none" -> False
880880 Just _ -> True
@@ -888,7 +888,7 @@ elemToParagraphStyle _ _ _ = defaultParagraphStyle
888888checkOnOff :: NameSpaces -> Element -> QName -> Maybe Bool
889889checkOnOff ns rPr tag
890890 | Just t <- findChild tag rPr
891− , Just val <- findAttr (elemName ns "w" "val") t =
891+ , Just val <- findAttrByName ns "w" "val" t =
892892 Just $ case val of
893893 "true" -> True
894894 "false" -> False
@@ -902,11 +902,11 @@ checkOnOff _ _ _ = Nothing
902902
903903elemToRunStyleD :: NameSpaces -> Element -> D RunStyle
904904elemToRunStyleD ns element
905− | Just rPr <- findChild (elemName ns "w" "rPr") element = do
905+ | Just rPr <- findChildByName ns "w" "rPr" element = do
906906 charStyles <- asks envCharStyles
907907 let parentSty = case
908− findChild (elemName ns "w" "rStyle") rPr >>=
909− findAttr (elemName ns "w" "val")
908+ findChildByName ns "w" "rStyle" rPr >>=
909+ findAttrByName ns "w" "val"
910910 of
911911 Just styName | Just style <- M.lookup styName charStyles ->
912912 Just (styName, style)
@@ -916,7 +916,7 @@ elemToRunStyleD _ _ = return defaultRunStyle
916916
917917elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle
918918elemToRunStyle ns element parentStyle
919− | Just rPr <- findChild (elemName ns "w" "rPr") element =
919+ | Just rPr <- findChildByName ns "w" "rPr" element =
920920 RunStyle
921921 {
922922 isBold = checkOnOff ns rPr (elemName ns "w" "b")
@@ -924,15 +924,15 @@ elemToRunStyle ns element parentStyle
924924 , isSmallCaps = checkOnOff ns rPr (elemName ns "w" "smallCaps")
925925 , isStrike = checkOnOff ns rPr (elemName ns "w" "strike")
926926 , rVertAlign =
927− findChild (elemName ns "w" "vertAlign") rPr >>=
928− findAttr (elemName ns "w" "val") >>=
927+ findChildByName ns "w" "vertAlign" rPr >>=
928+ findAttrByName ns "w" "val" >>=
929929 \v -> Just $ case v of
930930 "superscript" -> SupScrpt
931931 "subscript" -> SubScrpt
932932 _ -> BaseLn
933933 , rUnderline =
934− findChild (elemName ns "w" "u") rPr >>=
935− findAttr (elemName ns "w" "val")
934+ findChildByName ns "w" "u" rPr >>=
935+ findAttrByName ns "w" "val"
936936 , rStyle = parentStyle
937937 }
938938elemToRunStyle _ _ _ = defaultRunStyle
@@ -942,12 +942,12 @@ isNumericNotNull str = (str /= []) && (all isDigit str)
942942
943943getHeaderLevel :: NameSpaces -> Element -> Maybe (String,Int)
944944getHeaderLevel ns element
945− | Just styleId <- findAttr (elemName ns "w" "styleId") element
945+ | Just styleId <- findAttrByName ns "w" "styleId" element
946946 , Just index <- stripPrefix "Heading" styleId
947947 , isNumericNotNull index = Just (styleId, read index)
948− | Just styleId <- findAttr (elemName ns "w" "styleId") element
949− , Just index <- findChild (elemName ns "w" "name") element >>=
950− findAttr (elemName ns "w" "val") >>=
948+ | Just styleId <- findAttrByName ns "w" "styleId" element
949+ , Just index <- findChildByName ns "w" "name" element >>=
950+ findAttrByName ns "w" "val" >>=
951951 stripPrefix "heading "
952952 , isNumericNotNull index = Just (styleId, read index)
953953getHeaderLevel _ _ = Nothing
@@ -960,23 +960,23 @@ blockQuoteStyleNames = ["Quote", "Block Text"]
960960
961961getBlockQuote :: NameSpaces -> Element -> Maybe Bool
962962getBlockQuote ns element
963− | Just styleId <- findAttr (elemName ns "w" "styleId") element
963+ | Just styleId <- findAttrByName ns "w" "styleId" element
964964 , styleId `elem` blockQuoteStyleIds = Just True
965− | Just styleName <- findChild (elemName ns "w" "name") element >>=
966− findAttr (elemName ns "w" "val")
965+ | Just styleName <- findChildByName ns "w" "name" element >>=
966+ findAttrByName ns "w" "val"
967967 , styleName `elem` blockQuoteStyleNames = Just True
968968getBlockQuote _ _ = Nothing
969969
970970getNumInfo :: NameSpaces -> Element -> Maybe (String, String)
971971getNumInfo ns element = do
972− let numPr = findChild (elemName ns "w" "pPr") element >>=
973− findChild (elemName ns "w" "numPr")
972+ let numPr = findChildByName ns "w" "pPr" element >>=
973+ findChildByName ns "w" "numPr"
974974 lvl = fromMaybe "0" (numPr >>=
975− findChild (elemName ns "w" "ilvl") >>=
976− findAttr (elemName ns "w" "val"))
975+ findChildByName ns "w" "ilvl" >>=
976+ findAttrByName ns "w" "val")
977977 numId <- numPr >>=
978− findChild (elemName ns "w" "numId") >>=
979− findAttr (elemName ns "w" "val")
978+ findChildByName ns "w" "numId" >>=
979+ findAttrByName ns "w" "val"
980980 return (numId, lvl)
981981
982982
@@ -1020,8 +1020,8 @@ getSymChar ns element
10201020 let [(char, _)] = readLitChar ("\\x" ++ s) in
10211021 TextRun . maybe "" (:[]) $ getUnicode font char
10221022 where
1023− getCodepoint = findAttr (elemName ns "w" "char") element
1024− getFont = stringToFont =<< findAttr (elemName ns "w" "font") element
1023+ getCodepoint = findAttrByName ns "w" "char" element
1024+ getFont = stringToFont =<< findAttrByName ns "w" "font" element
10251025 lowerFromPrivate ('F':xs) = '0':xs
10261026 lowerFromPrivate xs = xs
10271027getSymChar _ _ = TextRun ""
src/Text/Pandoc/Readers/Docx/Util.hs+22−2
@@ -3,6 +3,9 @@ module Text.Pandoc.Readers.Docx.Util (
33 , elemName
44 , isElem
55 , elemToNameSpaces
6+ , findChildByName
7+ , findChildrenByName
8+ , findAttrByName
69 ) where
710
811import Text.XML.Light
@@ -23,5 +26,22 @@ elemName ns prefix name =
2326
2427isElem :: NameSpaces -> String -> String -> Element -> Bool
2528isElem ns prefix name element =
26− qName (elName element) == name &&
27− qURI (elName element) == lookup prefix ns
29+ let ns' = ns ++ elemToNameSpaces element
30+ in qName (elName element) == name &&
31+ qURI (elName element) == lookup prefix ns'
32+
33+findChildByName :: NameSpaces -> String -> String -> Element -> Maybe Element
34+findChildByName ns pref name el =
35+ let ns' = ns ++ elemToNameSpaces el
36+ in findChild (elemName ns' pref name) el
37+
38+findChildrenByName :: NameSpaces -> String -> String -> Element -> [Element]
39+findChildrenByName ns pref name el =
40+ let ns' = ns ++ elemToNameSpaces el
41+ in findChildren (elemName ns' pref name) el
42+
43+findAttrByName :: NameSpaces -> String -> String -> Element -> Maybe String
44+findAttrByName ns pref name el =
45+ let ns' = ns ++ elemToNameSpaces el
46+ in findAttr (elemName ns' pref name) el
47+