git.iko.soy/typeable/pandoc
on master help sign in
Docx Writer: Fix StyleMap

I've messed up badly with it, so it didn't work properly most of the time. At the plus side, fallback mechanic is working wonderfully.

commitd09b7593f60e056d82108a20ca13c48e6b51fc04 authorNikolay Yakimov <root@livid.pp.ru> dateTue 24 Mar 2015, 19:24 (12 years ago) parent75a2a7b
1 file changed+19−18
src/Text/Pandoc/Readers/Docx/StyleMap.hs+19−18
src/Text/Pandoc/Readers/Docx/StyleMap.hs+19−18
@@ -9,7 +9,6 @@ import Text.XML.Light
99import Text.Pandoc.Readers.Docx.Util
1010import Control.Monad.State
1111import Data.Char (toLower)
12−import Data.Maybe (fromMaybe)
1312import qualified Data.Map as M
1413
1514newtype ParaStyleMap = ParaStyleMap ( M.Map String String )
@@ -27,8 +26,9 @@ instance StyleMap CharStyleMap where
2726 alterMap f (CharStyleMap m) = CharStyleMap $ f m
2827 getMap (CharStyleMap m) = m
2928
30−insert :: (StyleMap a) => String -> String -> a -> a
31−insert k v = alterMap $ M.insert k v
29+insert :: (StyleMap a) => Maybe String -> Maybe String -> a -> a
30+insert (Just k) (Just v) m = alterMap (M.insert k v) m
31+insert _ _ m = m
3232
3333getStyleId :: (StyleMap a) => String -> a -> String
3434getStyleId s = M.findWithDefault (filter (/=' ') s) (map toLower s) . getMap
@@ -49,19 +49,20 @@ defaultStyleMaps = StyleMaps { sNameSpaces = []
4949 , sCharStyleMap = CharStyleMap M.empty
5050 }
5151
52−type StateM a = StateT StyleMaps Maybe a
52+type StateM a = State StyleMaps a
5353
5454getStyleMaps :: Element -> StyleMaps
55−getStyleMaps docElem = fromMaybe state' $ execStateT genStyleMap state'
55+getStyleMaps docElem = execState genStyleMap state'
5656 where
5757 state' = defaultStyleMaps {sNameSpaces = elemToNameSpaces docElem}
5858 genStyleItem e = do
5959 styleType <- getStyleType e
6060 styleId <- getAttrStyleId e
61− nameValLowercase <- map toLower `fmap` getNameVal e
61+ nameValLowercase <- fmap (map toLower) `fmap` getNameVal e
6262 case styleType of
63− ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId
64− CharStyle -> modCharStyleMap $ insert nameValLowercase styleId
63+ Just ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId
64+ Just CharStyle -> modCharStyleMap $ insert nameValLowercase styleId
65+ _ -> return ()
6566 genStyleMap = do
6667 style <- elemName' "style"
6768 let styles = findChildren style docElem
@@ -75,29 +76,29 @@ modCharStyleMap :: (CharStyleMap -> CharStyleMap) -> StateM ()
7576modCharStyleMap f = modify $ \s ->
7677 s {sCharStyleMap = f $ sCharStyleMap s}
7778
78−getStyleType :: Element -> StateM StyleType
79+getStyleType :: Element -> StateM (Maybe StyleType)
7980getStyleType e = do
8081 styleTypeStr <- getAttrType e
8182 case styleTypeStr of
82− "paragraph" -> return ParaStyle
83− "character" -> return CharStyle
84− _ -> lift Nothing
83+ Just "paragraph" -> return $ Just ParaStyle
84+ Just "character" -> return $ Just CharStyle
85+ _ -> return Nothing
8586
86−getAttrType :: Element -> StateM String
87+getAttrType :: Element -> StateM (Maybe String)
8788getAttrType el = do
8889 name <- elemName' "type"
89− lift $ findAttr name el
90+ return $ findAttr name el
9091
91−getAttrStyleId :: Element -> StateM String
92+getAttrStyleId :: Element -> StateM (Maybe String)
9293getAttrStyleId el = do
9394 name <- elemName' "styleId"
94− lift $ findAttr name el
95+ return $ findAttr name el
9596
96−getNameVal :: Element -> StateM String
97+getNameVal :: Element -> StateM (Maybe String)
9798getNameVal el = do
9899 name <- elemName' "name"
99100 val <- elemName' "val"
100− lift $ findChild name el >>= findAttr val
101+ return $ findChild name el >>= findAttr val
101102
102103elemName' :: String -> StateM QName
103104elemName' name = do