Code cleanup

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

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