d09b759 · typeable/pandoc

9import Text.Pandoc.Readers.Docx.Util

10import Control.Monad.State

11import Data.Char (toLower)

12−import Data.Maybe (fromMaybe)

13import qualified Data.Map as M

12import qualified Data.Map as M

14

13

15newtype ParaStyleMap = ParaStyleMap ( M.Map String String )

14newtype ParaStyleMap = ParaStyleMap ( M.Map String String )

27 alterMap f (CharStyleMap m) = CharStyleMap $ f m

26 alterMap f (CharStyleMap m) = CharStyleMap $ f m

28 getMap (CharStyleMap m) = m

27 getMap (CharStyleMap m) = m

29

28

30−insert :: (StyleMap a) => String -> String -> a -> a

29+insert :: (StyleMap a) => Maybe String -> Maybe String -> a -> a

31−insert k v = alterMap $ M.insert k v

30+insert (Just k) (Just v) m = alterMap (M.insert k v) m

31+insert _ _ m = m

32

33getStyleId :: (StyleMap a) => String -> a -> String

34getStyleId s = M.findWithDefault (filter (/=' ') s) (map toLower s) . getMap

49 , sCharStyleMap = CharStyleMap M.empty

50 }

51

52−type StateM a = StateT StyleMaps Maybe a

52+type StateM a = State StyleMaps a

53

54getStyleMaps :: Element -> StyleMaps

55−getStyleMaps docElem = fromMaybe state' $ execStateT genStyleMap state'

55+getStyleMaps docElem = execState genStyleMap state'

56 where

57 state' = defaultStyleMaps {sNameSpaces = elemToNameSpaces docElem}

58 genStyleItem e = do

59 styleType <- getStyleType e

60 styleId <- getAttrStyleId e

61− nameValLowercase <- map toLower `fmap` getNameVal e

61+ nameValLowercase <- fmap (map toLower) `fmap` getNameVal e

62 case styleType of

63− ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId

63+ Just ParaStyle -> modParaStyleMap $ insert nameValLowercase styleId

64− CharStyle -> modCharStyleMap $ insert nameValLowercase styleId

64+ Just CharStyle -> modCharStyleMap $ insert nameValLowercase styleId

65+ _ -> return ()

65 genStyleMap = do

66 genStyleMap = do

66 style <- elemName' "style"

67 style <- elemName' "style"

67 let styles = findChildren style docElem

68 let styles = findChildren style docElem

75modCharStyleMap f = modify $ \s ->

76modCharStyleMap f = modify $ \s ->

76 s {sCharStyleMap = f $ sCharStyleMap s}

77 s {sCharStyleMap = f $ sCharStyleMap s}

77

78

78−getStyleType :: Element -> StateM StyleType

79+getStyleType :: Element -> StateM (Maybe StyleType)

79getStyleType e = do

80getStyleType e = do

80 styleTypeStr <- getAttrType e

81 styleTypeStr <- getAttrType e

81 case styleTypeStr of

82 case styleTypeStr of

82− "paragraph" -> return ParaStyle

83+ Just "paragraph" -> return $ Just ParaStyle

83− "character" -> return CharStyle

84+ Just "character" -> return $ Just CharStyle

84− _ -> lift Nothing

85+ _ -> return Nothing

85

86

86−getAttrType :: Element -> StateM String

87+getAttrType :: Element -> StateM (Maybe String)

87getAttrType el = do

88getAttrType el = do

88 name <- elemName' "type"

89 name <- elemName' "type"

89− lift $ findAttr name el

90+ return $ findAttr name el

90

91

91−getAttrStyleId :: Element -> StateM String

92+getAttrStyleId :: Element -> StateM (Maybe String)

92getAttrStyleId el = do

93getAttrStyleId el = do

93 name <- elemName' "styleId"

94 name <- elemName' "styleId"

94− lift $ findAttr name el

95+ return $ findAttr name el

95

96

96−getNameVal :: Element -> StateM String

97+getNameVal :: Element -> StateM (Maybe String)

97getNameVal el = do

98getNameVal el = do

98 name <- elemName' "name"

99 name <- elemName' "name"

99 val <- elemName' "val"

100 val <- elemName' "val"

100− lift $ findChild name el >>= findAttr val

101+ return $ findChild name el >>= findAttr val

101

102

102elemName' :: String -> StateM QName

103elemName' :: String -> StateM QName

103elemName' name = do

104elemName' name = do