git.iko.soy/typeable/pandoc
on master help sign in
Code cleanup
65c8082Nikolay Yakimov
src/Text/Pandoc/Readers/Docx/StyleMap.hs+12−12
compare with master
unifiedsplit
@@ -1,7 +1,4 @@
1−module Text.Pandoc.Readers.Docx.StyleMap ( StyleMap
1+module Text.Pandoc.Readers.Docx.StyleMap ( StyleMaps(..)
2− , ParaStyleMap
3− , CharStyleMap
4− , StyleMaps(..)
5 , defaultStyleMaps
2 , defaultStyleMaps
6 , getStyleMaps
3 , getStyleMaps
7 , getStyleId
4 , getStyleId
@@ -58,23 +55,26 @@ getStyleMaps :: Element -> StyleMaps
58getStyleMaps docElem = fromMaybe state' $ execStateT genStyleMap state'
55getStyleMaps docElem = fromMaybe state' $ execStateT genStyleMap state'
59 where
56 where
60 state' = defaultStyleMaps {sNameSpaces = elemToNameSpaces docElem}
57 state' = defaultStyleMaps {sNameSpaces = elemToNameSpaces docElem}
61− insertPara key val = modify $ \s ->
62− s { sParaStyleMap = insert key val $ sParaStyleMap s }
63− insertChar key val = modify $ \s ->
64− s { sCharStyleMap = insert key val $ sCharStyleMap s }
65 genStyleItem e = do
58 genStyleItem e = do
66 styleType <- getStyleType e
59 styleType <- getStyleType e
67− nameVal <- getNameVal e
68 styleId <- getAttrStyleId e
60 styleId <- getAttrStyleId e
69− let nameValLC = map toLower nameVal
61+ nameValLowercase <- map toLower `fmap` getNameVal e
70 case styleType of
62 case styleType of
71− ParaStyle -> insertPara nameValLC styleId
63+ ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId
72− CharStyle -> insertChar nameValLC styleId
64+ CharStyle -> modCharStyleMap $ insert nameValLowercase styleId
73 genStyleMap = do
65 genStyleMap = do
74 style <- elemName' "style"
66 style <- elemName' "style"
75 let styles = findChildren style docElem
67 let styles = findChildren style docElem
76 forM_ styles genStyleItem
68 forM_ styles genStyleItem
77
69
70+modParaStyleMap :: (ParaStyleMap -> ParaStyleMap) -> StateM ()
71+modParaStyleMap f = modify $ \s ->
72+ s {sParaStyleMap = f $ sParaStyleMap s}
73+
74+modCharStyleMap :: (CharStyleMap -> CharStyleMap) -> StateM ()
75+modCharStyleMap f = modify $ \s ->
76+ s {sCharStyleMap = f $ sCharStyleMap s}
77+
78getStyleType :: Element -> StateM StyleType
78getStyleType :: Element -> StateM StyleType
79getStyleType e = do
79getStyleType e = do
80 styleTypeStr <- getAttrType e
80 styleTypeStr <- getAttrType e
src/Text/Pandoc/Writers/Docx.hs+10−14
@@ -620,27 +620,23 @@ writeOpenXML opts (Pandoc meta blocks) = do
620blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
620blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
621blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls
621blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls
622
622
623−pStyle :: String -> StyleMaps -> Element
624−pStyle sty m = mknode "w:pStyle" [("w:val",sty')] ()
625− where
626− sty' = getStyleId sty $ sParaStyleMap m
627−
628pCustomStyle :: String -> Element
623pCustomStyle :: String -> Element
629pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
624pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
630
625
631pStyleM :: String -> WS XML.Element
626pStyleM :: String -> WS XML.Element
627+pStyleM styleName = do
632−pStyleM = (`fmap` gets stStyleMaps) . pStyle
628+ styleMaps <- gets stStyleMaps
633−
629+ let sty' = getStyleId styleName $ sParaStyleMap styleMaps
634−rStyle :: String -> StyleMaps -> Element
630+ return $ mknode "w:pStyle" [("w:val",sty')] ()
635−rStyle sty m = mknode "w:rStyle" [("w:val",sty')] ()
636− where
637− sty' = getStyleId sty $ sCharStyleMap m
638
631
639rCustomStyle :: String -> Element
632rCustomStyle :: String -> Element
640rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
633rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
641
634
642rStyleM :: String -> WS XML.Element
635rStyleM :: String -> WS XML.Element
636+rStyleM styleName = do
643−rStyleM = (`fmap` gets stStyleMaps) . rStyle
637+ styleMaps <- gets stStyleMaps
638+ let sty' = getStyleId styleName $ sCharStyleMap styleMaps
639+ return $ mknode "w:rStyle" [("w:val",sty')] ()
644
640
645getUniqueId :: MonadIO m => m String
641getUniqueId :: MonadIO m => m String
646-- the + 20 is to ensure that there are no clashes with the rIds
642-- the + 20 is to ensure that there are no clashes with the rIds
@@ -689,10 +685,10 @@ blockToOpenXML opts (Para lst) = do
689 paraProps <- getParaProps $ case lst of
685 paraProps <- getParaProps $ case lst of
690 [Math DisplayMath _] -> True
686 [Math DisplayMath _] -> True
691 _ -> False
687 _ -> False
692− sm <- gets stStyleMaps
688+ bodyTextStyle <- pStyleM "Body Text"
693 let paraProps' = case paraProps of
689 let paraProps' = case paraProps of
694 [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]]
690 [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]]
695− [] -> [mknode "w:pPr" [] [pStyle "Body Text" sm]]
691+ [] -> [mknode "w:pPr" [] [bodyTextStyle]]
696 ps -> ps
692 ps -> ps
697 modify $ \s -> s { stFirstPara = False }
693 modify $ \s -> s { stFirstPara = False }
698 contents <- inlinesToOpenXML opts lst
694 contents <- inlinesToOpenXML opts lst