diff options
author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-08-13 13:46:21 -0400 |
---|---|---|
committer | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-08-13 13:46:21 -0400 |
commit | 347d716826249ea7eadc8332f48e1600c469abb0 (patch) | |
tree | 30ea0741af527b23383c0cd6ed3f4cb34ee7437a | |
parent | 1955ee9c72286c404f5f2376edff6b3d22e64004 (diff) | |
download | pandoc-347d716826249ea7eadc8332f48e1600c469abb0.tar.gz |
Docx parser: Use xml convenience functions
The functions `isElem` and `elemName` (defined in Docx/Util.hs) make the
code a lot cleaner than the original XML.Light functions, but they had
been used inconsistently. This puts them in wherever applicable.
-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) |