aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Docx/Parse.hs65
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)