diff options
Diffstat (limited to 'src/Text/Pandoc')
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx/StyleMap.hs | 24 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 24 |
2 files changed, 22 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Readers/Docx/StyleMap.hs b/src/Text/Pandoc/Readers/Docx/StyleMap.hs index 2e3d6db95..5a4e9cfc2 100644 --- a/src/Text/Pandoc/Readers/Docx/StyleMap.hs +++ b/src/Text/Pandoc/Readers/Docx/StyleMap.hs @@ -1,7 +1,4 @@ -module Text.Pandoc.Readers.Docx.StyleMap ( StyleMap - , ParaStyleMap - , CharStyleMap - , StyleMaps(..) +module Text.Pandoc.Readers.Docx.StyleMap ( StyleMaps(..) , defaultStyleMaps , getStyleMaps , getStyleId @@ -58,23 +55,26 @@ getStyleMaps :: Element -> StyleMaps getStyleMaps docElem = fromMaybe state' $ execStateT genStyleMap state' where state' = defaultStyleMaps {sNameSpaces = elemToNameSpaces docElem} - insertPara key val = modify $ \s -> - s { sParaStyleMap = insert key val $ sParaStyleMap s } - insertChar key val = modify $ \s -> - s { sCharStyleMap = insert key val $ sCharStyleMap s } genStyleItem e = do styleType <- getStyleType e - nameVal <- getNameVal e styleId <- getAttrStyleId e - let nameValLC = map toLower nameVal + nameValLowercase <- map toLower `fmap` getNameVal e case styleType of - ParaStyle -> insertPara nameValLC styleId - CharStyle -> insertChar nameValLC styleId + ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId + CharStyle -> modCharStyleMap $ insert nameValLowercase styleId genStyleMap = do style <- elemName' "style" let styles = findChildren style docElem forM_ styles genStyleItem +modParaStyleMap :: (ParaStyleMap -> ParaStyleMap) -> StateM () +modParaStyleMap f = modify $ \s -> + s {sParaStyleMap = f $ sParaStyleMap s} + +modCharStyleMap :: (CharStyleMap -> CharStyleMap) -> StateM () +modCharStyleMap f = modify $ \s -> + s {sCharStyleMap = f $ sCharStyleMap s} + getStyleType :: Element -> StateM StyleType getStyleType e = do styleTypeStr <- getAttrType e diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 53065309b..c4de12d2f 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -620,27 +620,23 @@ writeOpenXML opts (Pandoc meta blocks) = do blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element] blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls -pStyle :: String -> StyleMaps -> Element -pStyle sty m = mknode "w:pStyle" [("w:val",sty')] () - where - sty' = getStyleId sty $ sParaStyleMap m - pCustomStyle :: String -> Element pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] () pStyleM :: String -> WS XML.Element -pStyleM = (`fmap` gets stStyleMaps) . pStyle - -rStyle :: String -> StyleMaps -> Element -rStyle sty m = mknode "w:rStyle" [("w:val",sty')] () - where - sty' = getStyleId sty $ sCharStyleMap m +pStyleM styleName = do + styleMaps <- gets stStyleMaps + let sty' = getStyleId styleName $ sParaStyleMap styleMaps + return $ mknode "w:pStyle" [("w:val",sty')] () rCustomStyle :: String -> Element rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] () rStyleM :: String -> WS XML.Element -rStyleM = (`fmap` gets stStyleMaps) . rStyle +rStyleM styleName = do + styleMaps <- gets stStyleMaps + let sty' = getStyleId styleName $ sCharStyleMap styleMaps + return $ mknode "w:rStyle" [("w:val",sty')] () getUniqueId :: MonadIO m => m String -- the + 20 is to ensure that there are no clashes with the rIds @@ -689,10 +685,10 @@ blockToOpenXML opts (Para lst) = do paraProps <- getParaProps $ case lst of [Math DisplayMath _] -> True _ -> False - sm <- gets stStyleMaps + bodyTextStyle <- pStyleM "Body Text" let paraProps' = case paraProps of [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]] - [] -> [mknode "w:pPr" [] [pStyle "Body Text" sm]] + [] -> [mknode "w:pPr" [] [bodyTextStyle]] ps -> ps modify $ \s -> s { stFirstPara = False } contents <- inlinesToOpenXML opts lst |