git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: use Map instead of list for Namespaces.

This gives a speedup of about 5-10%. The reader is now approximately twice as fast as in the last release.

commit73add0578989e1da6e9cd1de68e2e4142f789188 authorJohn MacFarlane <jgm@berkeley.edu> dateWed 17 Feb 2021, 09:54 (6 years ago) parent80a1d5c
2 files changed+20−20
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Docx/Parse.hs+7−7 src/Text/Pandoc/Readers/Docx/Util.hs+13−13
src/Text/Pandoc/Readers/Docx/Parse.hs+7−7
@@ -396,9 +396,9 @@ archiveToNotes zf =
396396 >>= parseXMLFromEntry
397397 enElem = findEntryByPath "word/endnotes.xml" zf
398398 >>= parseXMLFromEntry
399− fn_namespaces = maybe [] elemToNameSpaces fnElem
400− en_namespaces = maybe [] elemToNameSpaces enElem
401− ns = unionBy (\x y -> fst x == fst y) fn_namespaces en_namespaces
399+ fn_namespaces = maybe mempty elemToNameSpaces fnElem
400+ en_namespaces = maybe mempty elemToNameSpaces enElem
401+ ns = M.union fn_namespaces en_namespaces
402402 fn = fnElem >>= elemToNotes ns "footnote" . walkDocument ns
403403 en = enElem >>= elemToNotes ns "endnote" . walkDocument ns
404404 in
@@ -408,7 +408,7 @@ archiveToComments :: Archive -> Comments
408408archiveToComments zf =
409409 let cmtsElem = findEntryByPath "word/comments.xml" zf
410410 >>= parseXMLFromEntry
411− cmts_namespaces = maybe [] elemToNameSpaces cmtsElem
411+ cmts_namespaces = maybe mempty elemToNameSpaces cmtsElem
412412 cmts = elemToComments cmts_namespaces . walkDocument cmts_namespaces <$>
413413 cmtsElem
414414 in
@@ -518,7 +518,7 @@ levelElemToLevel _ _ = Nothing
518518archiveToNumbering' :: Archive -> Maybe Numbering
519519archiveToNumbering' zf =
520520 case findEntryByPath "word/numbering.xml" zf of
521− Nothing -> Just $ Numbering [] [] []
521+ Nothing -> Just $ Numbering mempty [] []
522522 Just entry -> do
523523 numberingElem <- parseXMLFromEntry entry
524524 let namespaces = elemToNameSpaces numberingElem
@@ -530,7 +530,7 @@ archiveToNumbering' zf =
530530
531531archiveToNumbering :: Archive -> Numbering
532532archiveToNumbering archive =
533− fromMaybe (Numbering [] [] []) (archiveToNumbering' archive)
533+ fromMaybe (Numbering mempty [] []) (archiveToNumbering' archive)
534534
535535elemToNotes :: NameSpaces -> Text -> Element -> Maybe (M.Map T.Text Element)
536536elemToNotes ns notetype element
@@ -875,7 +875,7 @@ childElemToRun ns element
875875 = let (title, alt) = getTitleAndAlt ns element
876876 a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
877877 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"))
879879 in
880880 case drawing of
881881 Just s -> expandDrawingId s >>=
src/Text/Pandoc/Readers/Docx/Util.hs+13−13
@@ -22,42 +22,42 @@ module Text.Pandoc.Readers.Docx.Util (
2222 , findAttrByName
2323 ) where
2424
25−import Data.Maybe (mapMaybe)
2625import qualified Data.Text as T
2726import Data.Text (Text)
2827import Text.Pandoc.XML.Light
28+import qualified Data.Map as M
2929
30−type NameSpaces = [(Text, Text)]
30+type NameSpaces = M.Map Text Text
3131
3232elemToNameSpaces :: Element -> NameSpaces
33−elemToNameSpaces = mapMaybe attrToNSPair . elAttribs
34−
35−attrToNSPair :: Attr -> Maybe (Text, Text)
36−attrToNSPair (Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
37−attrToNSPair _ = Nothing
33+elemToNameSpaces = foldr (\(Attr qn val) ->
34+ case qn of
35+ QName s _ (Just "xmlns") -> M.insert s val
36+ _ -> id) mempty . elAttribs
3837
3938elemName :: NameSpaces -> Text -> Text -> QName
4039elemName ns prefix name =
41− QName name (lookup prefix ns) (if T.null prefix then Nothing else Just prefix)
40+ QName name (M.lookup prefix ns)
41+ (if T.null prefix then Nothing else Just prefix)
4242
4343isElem :: NameSpaces -> Text -> Text -> Element -> Bool
4444isElem ns prefix name element =
45− let ns' = ns ++ elemToNameSpaces element
45+ let ns' = ns <> elemToNameSpaces element
4646 in qName (elName element) == name &&
47− qURI (elName element) == lookup prefix ns'
47+ qURI (elName element) == M.lookup prefix ns'
4848
4949findChildByName :: NameSpaces -> Text -> Text -> Element -> Maybe Element
5050findChildByName ns pref name el =
51− let ns' = ns ++ elemToNameSpaces el
51+ let ns' = ns <> elemToNameSpaces el
5252 in findChild (elemName ns' pref name) el
5353
5454findChildrenByName :: NameSpaces -> Text -> Text -> Element -> [Element]
5555findChildrenByName ns pref name el =
56− let ns' = ns ++ elemToNameSpaces el
56+ let ns' = ns <> elemToNameSpaces el
5757 in findChildren (elemName ns' pref name) el
5858
5959findAttrByName :: NameSpaces -> Text -> Text -> Element -> Maybe Text
6060findAttrByName ns pref name el =
61− let ns' = ns ++ elemToNameSpaces el
61+ let ns' = ns <> elemToNameSpaces el
6262 in findAttr (elemName ns' pref name) el
6363