git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: use Map instead of list for Namespaces.
73add05John MacFarlane
src/Text/Pandoc/Readers/Docx/Parse.hs+7−7
compare with master
unifiedsplit
@@ -396,9 +396,9 @@ archiveToNotes zf =
396 >>= parseXMLFromEntry
396 >>= parseXMLFromEntry
397 enElem = findEntryByPath "word/endnotes.xml" zf
397 enElem = findEntryByPath "word/endnotes.xml" zf
398 >>= parseXMLFromEntry
398 >>= parseXMLFromEntry
399− fn_namespaces = maybe [] elemToNameSpaces fnElem
399+ fn_namespaces = maybe mempty elemToNameSpaces fnElem
400− en_namespaces = maybe [] elemToNameSpaces enElem
400+ en_namespaces = maybe mempty elemToNameSpaces enElem
401− ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces
401+ ns = M.union fn_namespaces en_namespaces
402 fn = fnElem >>= elemToNotes ns "footnote" . walkDocument ns
402 fn = fnElem >>= elemToNotes ns "footnote" . walkDocument ns
403 en = enElem >>= elemToNotes ns "endnote" . walkDocument ns
403 en = enElem >>= elemToNotes ns "endnote" . walkDocument ns
404 in
404 in
@@ -408,7 +408,7 @@ archiveToComments :: Archive -> Comments
408archiveToComments zf =
408archiveToComments zf =
409 let cmtsElem = findEntryByPath "word/comments.xml" zf
409 let cmtsElem = findEntryByPath "word/comments.xml" zf
410 >>= parseXMLFromEntry
410 >>= parseXMLFromEntry
411− cmts_namespaces = maybe [] elemToNameSpaces cmtsElem
411+ cmts_namespaces = maybe mempty elemToNameSpaces cmtsElem
412 cmts = elemToComments cmts_namespaces . walkDocument cmts_namespaces <$>
412 cmts = elemToComments cmts_namespaces . walkDocument cmts_namespaces <$>
413 cmtsElem
413 cmtsElem
414 in
414 in
@@ -518,7 +518,7 @@ levelElemToLevel _ _ = Nothing
518archiveToNumbering' :: Archive -> Maybe Numbering
518archiveToNumbering' :: Archive -> Maybe Numbering
519archiveToNumbering' zf =
519archiveToNumbering' zf =
520 case findEntryByPath "word/numbering.xml" zf of
520 case findEntryByPath "word/numbering.xml" zf of
521− Nothing -> Just $ Numbering [] [] []
521+ Nothing -> Just $ Numbering mempty [] []
522 Just entry -> do
522 Just entry -> do
523 numberingElem <- parseXMLFromEntry entry
523 numberingElem <- parseXMLFromEntry entry
524 let namespaces = elemToNameSpaces numberingElem
524 let namespaces = elemToNameSpaces numberingElem
@@ -530,7 +530,7 @@ archiveToNumbering' zf =
530
530
531archiveToNumbering :: Archive -> Numbering
531archiveToNumbering :: Archive -> Numbering
532archiveToNumbering archive =
532archiveToNumbering archive =
533− fromMaybe (Numbering [] [] []) (archiveToNumbering' archive)
533+ fromMaybe (Numbering mempty [] []) (archiveToNumbering' archive)
534
534
535elemToNotes :: NameSpaces -> Text -> Element -> Maybe (M.Map T.Text Element)
535elemToNotes :: NameSpaces -> Text -> Element -> Maybe (M.Map T.Text Element)
536elemToNotes ns notetype element
536elemToNotes ns notetype element
@@ -875,7 +875,7 @@ childElemToRun ns element
875 = let (title, alt) = getTitleAndAlt ns element
875 = let (title, alt) = getTitleAndAlt ns element
876 a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
876 a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
877 drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem
877 drawing = findElement (QName "blip" (Just a_ns) (Just "a")) picElem
878− >>= findAttr (QName "embed" (lookup "r" ns) (Just "r"))
878+ >>= findAttr (QName "embed" (M.lookup "r" ns) (Just "r"))
879 in
879 in
880 case drawing of
880 case drawing of
881 Just s -> expandDrawingId s >>=
881 Just s -> expandDrawingId s >>=
src/Text/Pandoc/Readers/Docx/Util.hs+13−13
@@ -22,42 +22,42 @@ module Text.Pandoc.Readers.Docx.Util (
22 , findAttrByName
22 , findAttrByName
23 ) where
23 ) where
24
24
25−import Data.Maybe (mapMaybe)
26import qualified Data.Text as T
25import qualified Data.Text as T
27import Data.Text (Text)
26import Data.Text (Text)
28import Text.Pandoc.XML.Light
27import Text.Pandoc.XML.Light
28+import qualified Data.Map as M
29
29
30−type NameSpaces = [(Text, Text)]
30+type NameSpaces = M.Map Text Text
31
31
32elemToNameSpaces :: Element -> NameSpaces
32elemToNameSpaces :: Element -> NameSpaces
33−elemToNameSpaces = mapMaybe attrToNSPair . elAttribs
33+elemToNameSpaces = foldr (\(Attr qn val) ->
34−
34+ case qn of
35−attrToNSPair :: Attr -> Maybe (Text, Text)
36−attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
35+ QName s _ (Just "xmlns") -> M.insert s val
37−attrToNSPair _ = Nothing
36+ _ -> id) mempty . elAttribs
38
37
39elemName :: NameSpaces -> Text -> Text -> QName
38elemName :: NameSpaces -> Text -> Text -> QName
40elemName ns prefix name =
39elemName ns prefix name =
40+ QName name (M.lookup prefix ns)
41− QName name (lookup prefix ns) (if T.null prefix then Nothing else Just prefix)
41+ (if T.null prefix then Nothing else Just prefix)
42
42
43isElem :: NameSpaces -> Text -> Text -> Element -> Bool
43isElem :: NameSpaces -> Text -> Text -> Element -> Bool
44isElem ns prefix name element =
44isElem ns prefix name element =
45− let ns' = ns ++ elemToNameSpaces element
45+ let ns' = ns <> elemToNameSpaces element
46 in qName (elName element) == name &&
46 in qName (elName element) == name &&
47− qURI (elName element) == lookup prefix ns'
47+ qURI (elName element) == M.lookup prefix ns'
48
48
49findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
49findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
50findChildByName ns pref name el =
50findChildByName ns pref name el =
51− let ns' = ns ++ elemToNameSpaces el
51+ let ns' = ns <> elemToNameSpaces el
52 in findChild (elemName ns' pref name) el
52 in findChild (elemName ns' pref name) el
53
53
54findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
54findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
55findChildrenByName ns pref name el =
55findChildrenByName ns pref name el =
56− let ns' = ns ++ elemToNameSpaces el
56+ let ns' = ns <> elemToNameSpaces el
57 in findChildren (elemName ns' pref name) el
57 in findChildren (elemName ns' pref name) el
58
58
59findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
59findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
60findAttrByName ns pref name el =
60findAttrByName ns pref name el =
61− let ns' = ns ++ elemToNameSpaces el
61+ let ns' = ns <> elemToNameSpaces el
62 in findAttr (elemName ns' pref name) el
62 in findAttr (elemName ns' pref name) el
63
63