Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Docx Parse: build a bottom-up style tree.

Browse source 
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
This commit is contained in:
Jesse Rosenthal 2014-08-17 15:46:17 -04:00
parent b8f1658c36
commit 99491f0d98
1 changed files with 31 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
src/Text/Pandoc/Readers/Docx/Parse.hs
View file

@ -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 =