diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx/Parse.hs | 65 |
1 files changed, 27 insertions, 38 deletions
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 055a67288..9ae7f22ec 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -457,40 +457,33 @@ lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do numElemToNum :: NameSpaces -> Element -> Maybe Numb -numElemToNum ns element | - qName (elName element) == "num" && - qURI (elName element) == (lookup "w" ns) = do - numId <- findAttr (QName "numId" (lookup "w" ns) (Just "w")) element - absNumId <- findChild (QName "abstractNumId" (lookup "w" ns) (Just "w")) element - >>= findAttr (QName "val" (lookup "w" ns) (Just "w")) - return $ Numb numId absNumId +numElemToNum ns element + | isElem ns "w" "num" element = do + numId <- findAttr (elemName ns "w" "numId") element + absNumId <- findChild (elemName ns "w" "abstractNumId") element + >>= findAttr (elemName ns "w" "val") + return $ Numb numId absNumId numElemToNum _ _ = Nothing absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb -absNumElemToAbsNum ns element | - qName (elName element) == "abstractNum" && - qURI (elName element) == (lookup "w" ns) = do - absNumId <- findAttr - (QName "abstractNumId" (lookup "w" ns) (Just "w")) - element - let levelElems = findChildren - (QName "lvl" (lookup "w" ns) (Just "w")) - element - levels = mapMaybe (levelElemToLevel ns) levelElems - return $ AbstractNumb absNumId levels +absNumElemToAbsNum ns element + | isElem ns "w" "abstractNum" element = do + absNumId <- findAttr (elemName ns "w" "abstractNumId") element + let levelElems = findChildren (elemName ns "w" "lvl") element + levels = mapMaybe (levelElemToLevel ns) levelElems + return $ AbstractNumb absNumId levels absNumElemToAbsNum _ _ = Nothing levelElemToLevel :: NameSpaces -> Element -> Maybe Level -levelElemToLevel ns element | - qName (elName element) == "lvl" && - qURI (elName element) == (lookup "w" ns) = do - ilvl <- findAttr (QName "ilvl" (lookup "w" ns) (Just "w")) element - fmt <- findChild (QName "numFmt" (lookup "w" ns) (Just "w")) element - >>= findAttr (QName "val" (lookup "w" ns) (Just "w")) - txt <- findChild (QName "lvlText" (lookup "w" ns) (Just "w")) element - >>= findAttr (QName "val" (lookup "w" ns) (Just "w")) - let start = findChild (QName "start" (lookup "w" ns) (Just "w")) element - >>= findAttr (QName "val" (lookup "w" ns) (Just "w")) +levelElemToLevel ns element + | isElem ns "w" "lvl" element = do + ilvl <- findAttr (elemName ns "w" "ilvl") element + fmt <- findChild (elemName ns "w" "numFmt") element + >>= findAttr (elemName ns "w" "val") + txt <- findChild (elemName ns "w" "lvlText") element + >>= findAttr (elemName ns "w" "val") + let start = findChild (elemName ns "w" "start") element + >>= findAttr (elemName ns "w" "val") >>= (\s -> listToMaybe (map fst (reads s :: [(Integer, String)]))) return (ilvl, fmt, txt, start) levelElemToLevel _ _ = Nothing @@ -502,12 +495,8 @@ archiveToNumbering' zf = do Just entry -> do numberingElem <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry let namespaces = elemToNameSpaces numberingElem - numElems = findChildren - (QName "num" (lookup "w" namespaces) (Just "w")) - numberingElem - absNumElems = findChildren - (QName "abstractNum" (lookup "w" namespaces) (Just "w")) - numberingElem + numElems = findChildren (elemName namespaces "w" "num") numberingElem + absNumElems = findChildren (elemName namespaces "w" "abstractNum") numberingElem nums = mapMaybe (numElemToNum namespaces) numElems absNums = mapMaybe (absNumElemToAbsNum namespaces) absNumElems return $ Numbering namespaces nums absNums @@ -584,13 +573,13 @@ elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation elemToParIndentation ns element | isElem ns "w" "ind" element = Just $ ParIndentation { leftParIndent = - findAttr (QName "left" (lookup "w" ns) (Just "w")) element >>= + findAttr (elemName ns "w" "left") element >>= stringToInteger , rightParIndent = - findAttr (QName "right" (lookup "w" ns) (Just "w")) element >>= + findAttr (elemName ns "w" "right") element >>= stringToInteger , hangingParIndent = - findAttr (QName "hanging" (lookup "w" ns) (Just "w")) element >>= + findAttr (elemName ns "w" "hanging") element >>= stringToInteger} elemToParIndentation _ _ = Nothing @@ -677,7 +666,7 @@ elemToParPart ns element , Just drawingElem <- findChild (elemName ns "w" "drawing") element = let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) element - >>= findAttr (QName "embed" (lookup "r" ns) (Just "r")) + >>= findAttr (elemName ns "r" "embed") in case drawing of Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs $ elemToExtent drawingElem) |