From 99491f0d988ea821580916d9566a3d2ab47fc236 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Sun, 17 Aug 2014 15:46:17 -0400
Subject: [PATCH] Docx Parse: build a bottom-up style tree.
Two points here: (1) We're going bottom-up, from styles not based on
anything, to avoid circular dependencies or any other sort of
maliciousness/incompetence. And (2) each style points to its
parent. That way, we don't need the whole tree to pass a style over to
Docx.hs
---
src/Text/Pandoc/Readers/Docx/Parse.hs | 37 ++++++++++++++++++++++-----
1 file changed, 31 insertions(+), 6 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs
index bfeccd5a1..e7a6c3ffb 100644
--- a/src/Text/Pandoc/Readers/Docx/Parse.hs
+++ b/src/Text/Pandoc/Readers/Docx/Parse.hs
@@ -273,17 +273,42 @@ archiveToStyles zf =
Just styElem ->
let namespaces = mapMaybe attrToNSPair (elAttribs styElem)
in
- M.fromList $ mapMaybe (elemToCharStyle namespaces) (elChildren styElem)
+ M.fromList $ buildBasedOnList namespaces styElem Nothing
-elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle
-elemToCharStyle ns element
+isBasedOnStyle :: NameSpaces -> Element -> Maybe CharStyle -> Bool
+isBasedOnStyle ns element parentStyle
| isElem ns "w" "style" element
, Just "character" <- findAttr (elemName ns "w" "type") element
- , Just styleId <- findAttr (elemName ns "w" "styleId") element
- , isJust $ findChild (elemName ns "w" "rPr") element =
- Just (styleId, elemToRunStyle ns element Nothing)
+ , Just basedOnVal <- findChild (elemName ns "w" "basedOn") element >>=
+ findAttr (elemName ns "w" "val")
+ , Just (parentId, _) <- parentStyle = (basedOnVal == parentId)
+ | isElem ns "w" "style" element
+ , Just "character" <- findAttr (elemName ns "w" "type") element
+ , Nothing <- findChild (elemName ns "w" "basedOn") element
+ , Nothing <- parentStyle = True
+ | otherwise = False
+
+elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle
+elemToCharStyle ns element parentStyle
+ | isElem ns "w" "style" element
+ , Just "character" <- findAttr (elemName ns "w" "type") element
+ , Just styleId <- findAttr (elemName ns "w" "styleId") element =
+ Just (styleId, elemToRunStyle ns element parentStyle)
| otherwise = Nothing
+getStyleChildren :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle]
+getStyleChildren ns element parentStyle
+ | isElem ns "w" "styles" element =
+ mapMaybe (\e -> elemToCharStyle ns e parentStyle) $
+ filterChildren (\e' -> isBasedOnStyle ns e' parentStyle) element
+ | otherwise = []
+
+buildBasedOnList :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle]
+buildBasedOnList ns element rootStyle =
+ case (getStyleChildren ns element rootStyle) of
+ [] -> []
+ stys -> stys ++
+ (concatMap (\s -> buildBasedOnList ns element (Just s)) stys)
archiveToNotes :: Archive -> Notes
archiveToNotes zf =