@@ -40,6 +40,7 @@ import Control.Applicative ( (<$>) )
4040import Control.Arrow ( (***), (>>>) )
4141import Control.Monad.State hiding ( when )
4242import Data.Char (chr)
43+import qualified Data.Map as Map
4344
4445-- | Auxiliary function to convert Plain block to Para.
4546plainToPara :: Block -> Block
@@ -56,7 +57,7 @@ data WriterState =
5657 , stParaStyles :: [Doc]
5758 , stListStyles :: [(Int, [Doc])]
5859 , stTextStyles :: [Doc]
59− , stTextStyleAttr :: [(TextStyle,[(String,String)])]
60+ , stTextStyleAttr :: Map.Map TextStyle [(String,String)]
6061 , stIndentPara :: Int
6162 , stInDefinition :: Bool
6263 , stTight :: Bool
@@ -69,7 +70,7 @@ defaultWriterState =
6970 , stParaStyles = []
7071 , stListStyles = []
7172 , stTextStyles = []
72− , stTextStyleAttr = []
73+ , stTextStyleAttr = Map.empty
7374 , stIndentPara = 0
7475 , stInDefinition = False
7576 , stTight = False
@@ -91,11 +92,10 @@ addTextStyle :: Doc -> State WriterState ()
9192addTextStyle i = modify $ \s -> s { stTextStyles = i : stTextStyles s }
9293
9394addTextStyleAttr :: (TextStyle, [(String,String)]) -> State WriterState ()
94−addTextStyleAttr i = modify $ \s -> s { stTextStyleAttr = i : stTextStyleAttr s }
95+addTextStyleAttr (ts, xs) = modify $ \s -> s { stTextStyleAttr = Map.insert ts xs (stTextStyleAttr s) }
9596
96−rmTextStyleAttr :: State WriterState ()
97−rmTextStyleAttr = modify $ \s -> s { stTextStyleAttr = rmHead (stTextStyleAttr s) }
98− where rmHead l = if l /= [] then tail l else []
97+rmTextStyleAttr :: TextStyle -> State WriterState ()
98+rmTextStyleAttr ts = modify $ \s -> s { stTextStyleAttr = Map.delete ts (stTextStyleAttr s) }
9999
100100increaseIndent :: State WriterState ()
101101increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
@@ -121,18 +121,18 @@ inSpanTags s = inTags False "text:span" [("text:style-name",s)]
121121
122122withTextStyle :: TextStyle -> State WriterState a -> State WriterState a
123123withTextStyle s f = addTextStyleAttr (s,textStyleAttr s) >>
124− f >>= \r -> rmTextStyleAttr >> return r
124+ f >>= \r -> rmTextStyleAttr s >> return r
125125
126126inTextStyle :: Doc -> State WriterState Doc
127127inTextStyle d = do
128128 at <- gets stTextStyleAttr
129− if at == []
129+ if Map.null at
130130 then return d
131131 else do
132132 tn <- (+) 1 . length <$> gets stTextStyles
133133 addTextStyle $ inTags False "style:style" [("style:name" , "T" ++ show tn)
134134 ,("style:family", "text" )]
135− $ selfClosingTag "style:text-properties" (concatMap snd at)
135+ $ selfClosingTag "style:text-properties" (concatMap snd $ Map.toList at)
136136 return $ inTags False "text:span" [("text:style-name","T" ++ show tn)] d
137137
138138inHeaderTags :: Int -> Doc -> Doc
@@ -491,7 +491,7 @@ paraTableStyles t s (a:xs)
491491 [ ("fo:text-align", x)
492492 , ("style:justify-single-word", "false")]
493493
494−data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC deriving ( Eq )
494+data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC deriving ( Eq,Ord )
495495
496496textStyleAttr :: TextStyle -> [(String,String)]
497497textStyleAttr s