{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleContexts #-} {- Copyright (C) 2008-2015 Andrea Rossato and John MacFarlane. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Writers.OpenDocument Copyright : Copyright (C) 2008-2015 Andrea Rossato and John MacFarlane License : GNU GPL, version 2 or above Maintainer : Andrea Rossato Stability : alpha Portability : portable Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.XML import Text.Pandoc.Shared (linesToPara) import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.Math import Text.Pandoc.Pretty import Text.Printf ( printf ) import Control.Arrow ( (***), (>>>) ) import Control.Monad.State hiding ( when ) import Data.Char (chr) import qualified Data.Set as Set import qualified Data.Map as Map import Text.Pandoc.Writers.Shared import Data.List (sortBy) import Data.Ord (comparing) import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Logging -- | Auxiliary function to convert Plain block to Para. plainToPara :: Block -> Block plainToPara (Plain x) = Para x plainToPara x = x -- -- OpenDocument writer -- type OD m = StateT WriterState m data WriterState = WriterState { stNotes :: [Doc] , stTableStyles :: [Doc] , stParaStyles :: [Doc] , stListStyles :: [(Int, [Doc])] , stTextStyles :: Map.Map (Set.Set TextStyle) (String, Doc) , stTextStyleAttr :: Set.Set TextStyle , stIndentPara :: Int , stInDefinition :: Bool , stTight :: Bool , stFirstPara :: Bool , stImageId :: Int } defaultWriterState :: WriterState defaultWriterState = WriterState { stNotes = [] , stTableStyles = [] , stParaStyles = [] , stListStyles = [] , stTextStyles = Map.empty , stTextStyleAttr = Set.empty , stIndentPara = 0 , stInDefinition = False , stTight = False , stFirstPara = False , stImageId = 1 } when :: Bool -> Doc -> Doc when p a = if p then a else empty addTableStyle :: PandocMonad m => Doc -> OD m () addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s } addNote :: PandocMonad m => Doc -> OD m () addNote i = modify $ \s -> s { stNotes = i : stNotes s } addParaStyle :: PandocMonad m => Doc -> OD m () addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s } addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m () addTextStyle attrs i = modify $ \s -> s { stTextStyles = Map.insert attrs i (stTextStyles s) } addTextStyleAttr :: PandocMonad m => TextStyle -> OD m () addTextStyleAttr t = modify $ \s -> s { stTextStyleAttr = Set.insert t (stTextStyleAttr s) } increaseIndent :: PandocMonad m => OD m () increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s } resetIndent :: PandocMonad m => OD m () resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 } inTightList :: PandocMonad m => OD m a -> OD m a inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r -> modify (\s -> s { stTight = False }) >> return r setInDefinitionList :: PandocMonad m => Bool -> OD m () setInDefinitionList b = modify $ \s -> s { stInDefinition = b } setFirstPara :: PandocMonad m => OD m () setFirstPara = modify $ \s -> s { stFirstPara = True } inParagraphTags :: PandocMonad m => Doc -> OD m Doc inParagraphTags d | isEmpty d = return empty inParagraphTags d = do b <- gets stFirstPara a <- if b then do modify $ \st -> st { stFirstPara = False } return $ [("text:style-name", "First_20_paragraph")] else return [("text:style-name", "Text_20_body")] return $ inTags False "text:p" a d inParagraphTagsWithStyle :: String -> Doc -> Doc inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)] inSpanTags :: String -> Doc -> Doc inSpanTags s = inTags False "text:span" [("text:style-name",s)] withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a withTextStyle s f = do oldTextStyleAttr <- gets stTextStyleAttr addTextStyleAttr s res <- f modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr } return res inTextStyle :: PandocMonad m => Doc -> OD m Doc inTextStyle d = do at <- gets stTextStyleAttr if Set.null at then return d else do styles <- gets stTextStyles case Map.lookup at styles of Just (styleName, _) -> return $ inTags False "text:span" [("text:style-name",styleName)] d Nothing -> do let styleName = "T" ++ show (Map.size styles + 1) addTextStyle at (styleName, inTags False "style:style" [("style:name", styleName) ,("style:family", "text")] $ selfClosingTag "style:text-properties" (concatMap textStyleAttr (Set.toList at))) return $ inTags False "text:span" [("text:style-name",styleName)] d inHeaderTags :: PandocMonad m => Int -> Doc -> OD m Doc inHeaderTags i d = return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i) , ("text:outline-level", show i)] d inQuotes :: QuoteType -> Doc -> Doc inQuotes SingleQuote s = char '\8216' <> s <> char '\8217' inQuotes DoubleQuote s = char '\8220' <> s <> char '\8221' handleSpaces :: String -> Doc handleSpaces s | ( ' ':_) <- s = genTag s | ('\t':x) <- s = selfClosingTag "text:tab" [] <> rm x | otherwise = rm s where genTag = span (==' ') >>> tag . length *** rm >>> uncurry (<>) tag n = when (n /= 0) $ selfClosingTag "text:s" [("text:c", show n)] rm ( ' ':xs) = char ' ' <> genTag xs rm ('\t':xs) = selfClosingTag "text:tab" [] <> genTag xs rm ( x:xs) = char x <> rm xs rm [] = empty -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String writeOpenDocument opts (Pandoc meta blocks) = do let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let render' = render colwidth ((body, metadata),s) <- flip runStateT defaultWriterState $ do m <- metaToJSON opts (fmap (render colwidth) . blocksToOpenDocument opts) (fmap (render colwidth) . inlinesToOpenDocument opts) meta b <- render' `fmap` blocksToOpenDocument opts blocks return (b, m) let styles = stTableStyles s ++ stParaStyles s ++ map snd (reverse $ sortBy (comparing fst) $ Map.elems (stTextStyles s)) listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) let listStyles = map listStyle (stListStyles s) let automaticStyles = vcat $ reverse $ styles ++ listStyles let context = defField "body" body $ defField "automatic-styles" (render' automaticStyles) $ metadata return $ case writerTemplate opts of Nothing -> body Just tpl -> renderTemplate' tpl context withParagraphStyle :: PandocMonad m => WriterOptions -> String -> [Block] -> OD m Doc withParagraphStyle o s (b:bs) | Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l | otherwise = go =<< blockToOpenDocument o b where go i = (<>) i <$> withParagraphStyle o s bs withParagraphStyle _ _ [] = return empty inPreformattedTags :: PandocMonad m => String -> OD m Doc inPreformattedTags s = do n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")] return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s orderedListToOpenDocument :: PandocMonad m => WriterOptions -> Int -> [[Block]] -> OD m Doc orderedListToOpenDocument o pn bs = vcat . map (inTagsIndented "text:list-item") <$> mapM (orderedItemToOpenDocument o pn . map plainToPara) bs orderedItemToOpenDocument :: PandocMonad m => WriterOptions -> Int -> [Block] -> OD m Doc orderedItemToOpenDocument o n (b:bs) | OrderedList a l <- b = go =<< newLevel a l | Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show n) <$> inlinesToOpenDocument o l | otherwise = go =<< blockToOpenDocument o b where go i = ($$) i <$> orderedItemToOpenDocument o n bs newLevel a l = do nn <- length <$> gets stParaStyles ls <- head <$> gets stListStyles modify $ \s -> s { stListStyles = orderedListLevelStyle a ls : tail (stListStyles s) } inTagsIndented "text:list" <$> orderedListToOpenDocument o nn l orderedItemToOpenDocument _ _ [] = return empty isTightList :: [[Block]] -> Bool isTightList [] = False isTightList (b:_) | Plain {} : _ <- b = True | otherwise = False newOrderedListStyle :: PandocMonad m => Bool -> ListAttributes -> OD m (Int,Int) newOrderedListStyle b a = do ln <- (+) 1 . length <$> gets stListStyles let nbs = orderedListLevelStyle a (ln, []) pn <- if b then inTightList (paraListStyle ln) else paraListStyle ln modify $ \s -> s { stListStyles = nbs : stListStyles s } return (ln,pn) bulletListToOpenDocument :: PandocMonad m => WriterOptions -> [[Block]] -> OD m Doc bulletListToOpenDocument o b = do ln <- (+) 1 . length <$> gets stListStyles (pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln modify $ \s -> s { stListStyles = ns : stListStyles s } is <- listItemsToOpenDocument ("P" ++ show pn) o b return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is listItemsToOpenDocument :: PandocMonad m => String -> WriterOptions -> [[Block]] -> OD m Doc listItemsToOpenDocument s o is = vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is deflistItemToOpenDocument :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) -> OD m Doc deflistItemToOpenDocument o (t,d) = do let ts = if isTightList d then "Definition_20_Term_20_Tight" else "Definition_20_Term" ds = if isTightList d then "Definition_20_Definition_20_Tight" else "Definition_20_Definition" t' <- withParagraphStyle o ts [Para t] d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d return $ t' $$ d' inBlockQuote :: PandocMonad m => WriterOptions -> Int -> [Block] -> OD m Doc inBlockQuote o i (b:bs) | BlockQuote l <- b = do increaseIndent ni <- paraStyle [("style:parent-style-name","Quotations")] go =<< inBlockQuote o ni (map plainToPara l) | Para l <- b = do go =<< inParagraphTagsWithStyle ("P" ++ show i) <$> inlinesToOpenDocument o l | otherwise = do go =<< blockToOpenDocument o b where go block = ($$) block <$> inBlockQuote o i bs inBlockQuote _ _ [] = resetIndent >> return empty -- | Convert a list of Pandoc blocks to OpenDocument. blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b -- | Convert a Pandoc block element to OpenDocument. blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc blockToOpenDocument o bs | Plain b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs = figure attr c s t | Para b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b | Div _ xs <- bs = blocksToOpenDocument o xs | Header i _ b <- bs = setFirstPara >> (inHeaderTags i =<< inlinesToOpenDocument o b) | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b | DefinitionList b <- bs = setFirstPara >> defList b | BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b | OrderedList a b <- bs = setFirstPara >> orderedList a b | CodeBlock _ s <- bs = setFirstPara >> preformatted s | Table c a w h r <- bs = setFirstPara >> table c a w h r | HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p" [ ("text:style-name", "Horizontal_20_Line") ]) | RawBlock f s <- bs = if f == Format "opendocument" then return $ text s else do report $ BlockNotRendered bs return empty | Null <- bs = return empty | otherwise = return empty where defList b = do setInDefinitionList True r <- vcat <$> mapM (deflistItemToOpenDocument o) b setInDefinitionList False return r preformatted s = (flush . vcat) <$> mapM (inPreformattedTags . escapeStringForXML) (lines s) mkBlockQuote b = do increaseIndent i <- paraStyle [("style:parent-style-name","Quotations")] inBlockQuote o i (map plainToPara b) orderedList a b = do (ln,pn) <- newOrderedListStyle (isTightList b) a inTags True "text:list" [ ("text:style-name", "L" ++ show ln)] <$> orderedListToOpenDocument o pn b table c a w h r = do tn <- length <$> gets stTableStyles pn <- length <$> gets stParaStyles let genIds = map chr [65..] name = "Table" ++ show (tn + 1) columnIds = zip genIds w mkColumn n = selfClosingTag "table:table-column" [("table:style-name", name ++ "." ++ [fst n])] columns = map mkColumn columnIds paraHStyles = paraTableStyles "Heading" pn a paraStyles = paraTableStyles "Contents" (pn + length (newPara paraHStyles)) a newPara = map snd . filter (not . isEmpty . snd) addTableStyle $ tableStyle tn columnIds mapM_ addParaStyle . newPara $ paraHStyles ++ paraStyles captionDoc <- if null c then return empty else withParagraphStyle o "Table" [Para c] th <- if all null h then return empty else colHeadsToOpenDocument o name (map fst paraHStyles) h tr <- mapM (tableRowToOpenDocument o name (map fst paraStyles)) r return $ inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) $$ captionDoc figure attr caption source title | null caption = withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] | otherwise = do imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] captionDoc <- withParagraphStyle o "FigureCaption" [Para caption] return $ imageDoc $$ captionDoc colHeadsToOpenDocument :: PandocMonad m => WriterOptions -> String -> [String] -> [[Block]] -> OD m Doc colHeadsToOpenDocument o tn ns hs = inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$> mapM (tableItemToOpenDocument o tn) (zip ns hs) tableRowToOpenDocument :: PandocMonad m => WriterOptions -> String -> [String] -> [[Block]] -> OD m Doc tableRowToOpenDocument o tn ns cs = inTagsIndented "table:table-row" . vcat <$> mapM (tableItemToOpenDocument o tn) (zip ns cs) tableItemToOpenDocument :: PandocMonad m => WriterOptions -> String -> (String,[Block]) -> OD m Doc tableItemToOpenDocument o tn (n,i) = let a = [ ("table:style-name" , tn ++ ".A1" ) , ("office:value-type", "string" ) ] in inTags True "table:table-cell" a <$> withParagraphStyle o n (map plainToPara i) -- | Convert a list of inline elements to OpenDocument. inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc inlinesToOpenDocument o l = hcat <$> toChunks o l toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc] toChunks _ [] = return [] toChunks o (x : xs) | isChunkable x = do contents <- (inTextStyle . hcat) =<< mapM (inlineToOpenDocument o) (x:ys) rest <- toChunks o zs return (contents : rest) | otherwise = do contents <- inlineToOpenDocument o x rest <- toChunks o xs return (contents : rest) where (ys, zs) = span isChunkable xs isChunkable :: Inline -> Bool isChunkable (Str _) = True isChunkable Space = True isChunkable SoftBreak = True isChunkable _ = False -- | Convert an inline element to OpenDocument. inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc inlineToOpenDocument o ils = case ils of Space -> return space SoftBreak | writerWrapText o == WrapPreserve -> return $ preformatted "\n" | otherwise -> return $ space Span _ xs -> inlinesToOpenDocument o xs LineBreak -> return $ selfClosingTag "text:line-break" [] Str s -> return $ handleSpaces $ escapeStringForXML s Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l Strong l -> withTextStyle Bold $ inlinesToOpenDocument o l Strikeout l -> withTextStyle Strike $ inlinesToOpenDocument o l Superscript l -> withTextStyle Sup $ inlinesToOpenDocument o l Subscript l -> withTextStyle Sub $ inlinesToOpenDocument o l SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l Code _ s -> inlinedCode $ preformatted s Math t s -> lift (texMathToInlines t s) >>= inlinesToOpenDocument o Cite _ l -> inlinesToOpenDocument o l RawInline f s -> if f == Format "opendocument" then return $ text s else do report $ InlineNotRendered ils return empty Link _ l (s,t) -> mkLink s t <$> inlinesToOpenDocument o l Image attr _ (s,t) -> mkImg attr s t Note l -> mkNote l where preformatted s = handleSpaces $ escapeStringForXML s inlinedCode s = return $ inTags False "text:span" [("text:style-name", "Source_Text")] s mkLink s t = inTags False "text:a" [ ("xlink:type" , "simple") , ("xlink:href" , s ) , ("office:name", t ) ] . inSpanTags "Definition" mkImg (_, _, kvs) s _ = do id' <- gets stImageId modify (\st -> st{ stImageId = id' + 1 }) let getDims [] = [] getDims (("width", w) :xs) = ("svg:width", w) : getDims xs getDims (("height", h):xs) = ("svg:height", h) : getDims xs getDims (_:xs) = getDims xs return $ inTags False "draw:frame" (("draw:name", "img" ++ show id') : getDims kvs) $ selfClosingTag "draw:image" [ ("xlink:href" , s ) , ("xlink:type" , "simple") , ("xlink:show" , "embed" ) , ("xlink:actuate", "onLoad")] mkNote l = do n <- length <$> gets stNotes let footNote t = inTags False "text:note" [ ("text:id" , "ftn" ++ show n) , ("text:note-class", "footnote" )] $ inTagsSimple "text:note-citation" (text . show $ n + 1) <> inTagsSimple "text:note-body" t nn <- footNote <$> withParagraphStyle o "Footnote" l addNote nn return nn bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc])) bulletListStyle l = do let doStyles i = inTags True "text:list-level-style-bullet" [ ("text:level" , show (i + 1) ) , ("text:style-name" , "Bullet_20_Symbols") , ("style:num-suffix", "." ) , ("text:bullet-char", [bulletList !! i] ) ] (listLevelStyle (1 + i)) bulletList = map chr $ cycle [8226,8227,8259] listElStyle = map doStyles [0..9] pn <- paraListStyle l return (pn, (l, listElStyle)) orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc]) orderedListLevelStyle (s,n, d) (l,ls) = let suffix = case d of OneParen -> [("style:num-suffix", ")")] TwoParens -> [("style:num-prefix", "(") ,("style:num-suffix", ")")] _ -> [("style:num-suffix", ".")] format = case n of UpperAlpha -> "A" LowerAlpha -> "a" UpperRoman -> "I" LowerRoman -> "i" _ -> "1" listStyle = inTags True "text:list-level-style-number" ([ ("text:level" , show $ 1 + length ls ) , ("text:style-name" , "Numbering_20_Symbols") , ("style:num-format", format ) , ("text:start-value", show s ) ] ++ suffix) (listLevelStyle (1 + length ls)) in (l, ls ++ [listStyle]) listLevelStyle :: Int -> Doc listLevelStyle i = let indent = show (0.25 * fromIntegral i :: Double) in selfClosingTag "style:list-level-properties" [ ("text:space-before" , indent ++ "in") , ("text:min-label-width", "0.25in")] tableStyle :: Int -> [(Char,Double)] -> Doc tableStyle num wcs = let tableId = "Table" ++ show (num + 1) table = inTags True "style:style" [("style:name", tableId) ,("style:family", "table")] $ selfClosingTag "style:table-properties" [("table:align" , "center")] colStyle (c,0) = selfClosingTag "style:style" [ ("style:name" , tableId ++ "." ++ [c]) , ("style:family", "table-column" )] colStyle (c,w) = inTags True "style:style" [ ("style:name" , tableId ++ "." ++ [c]) , ("style:family", "table-column" )] $ selfClosingTag "style:table-column-properties" [("style:rel-column-width", printf "%d*" $ (floor $ w * 65535 :: Integer))] cellStyle = inTags True "style:style" [ ("style:name" , tableId ++ ".A1") , ("style:family", "table-cell" )] $ selfClosingTag "style:table-cell-properties" [ ("fo:border", "none")] columnStyles = map colStyle wcs in table $$ vcat columnStyles $$ cellStyle paraStyle :: PandocMonad m => [(String,String)] -> OD m Int paraStyle attrs = do pn <- (+) 1 . length <$> gets stParaStyles i <- (*) (0.5 :: Double) . fromIntegral <$> gets stIndentPara b <- gets stInDefinition t <- gets stTight let styleAttr = [ ("style:name" , "P" ++ show pn) , ("style:family" , "paragraph" )] indentVal = flip (++) "in" . show $ if b then (max 0.5 i) else i tight = if t then [ ("fo:margin-top" , "0in" ) , ("fo:margin-bottom" , "0in" )] else [] indent = if (i /= 0 || b) then [ ("fo:margin-left" , indentVal) , ("fo:margin-right" , "0in" ) , ("fo:text-indent" , "0in" ) , ("style:auto-text-indent" , "false" )] else [] attributes = indent ++ tight paraProps = when (not $ null attributes) $ selfClosingTag "style:paragraph-properties" attributes addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps return pn paraListStyle :: PandocMonad m => Int -> OD m Int paraListStyle l = paraStyle [("style:parent-style-name","Text_20_body") ,("style:list-style-name", "L" ++ show l )] paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)] paraTableStyles _ _ [] = [] paraTableStyles t s (a:xs) | AlignRight <- a = ( pName s, res s "end" ) : paraTableStyles t (s + 1) xs | AlignCenter <- a = ( pName s, res s "center") : paraTableStyles t (s + 1) xs | otherwise = ("Table_20_" ++ t, empty ) : paraTableStyles t s xs where pName sn = "P" ++ show (sn + 1) res sn x = inTags True "style:style" [ ("style:name" , pName sn ) , ("style:family" , "paragraph" ) , ("style:parent-style-name", "Table_20_" ++ t)] $ selfClosingTag "style:paragraph-properties" [ ("fo:text-align", x) , ("style:justify-single-word", "false")] data TextStyle = Italic | Bold | Strike | Sub | Sup | SmallC | Pre deriving ( Eq,Ord ) textStyleAttr :: TextStyle -> [(String,String)] textStyleAttr s | Italic <- s = [("fo:font-style" ,"italic" ) ,("style:font-style-asian" ,"italic" ) ,("style:font-style-complex" ,"italic" )] | Bold <- s = [("fo:font-weight" ,"bold" ) ,("style:font-weight-asian" ,"bold" ) ,("style:font-weight-complex" ,"bold" )] | Strike <- s = [("style:text-line-through-style", "solid" )] | Sub <- s = [("style:text-position" ,"sub 58%" )] | Sup <- s = [("style:text-position" ,"super 58%" )] | SmallC <- s = [("fo:font-variant" ,"small-caps")] | Pre <- s = [("style:font-name" ,"Courier New") ,("style:font-name-asian" ,"Courier New") ,("style:font-name-complex" ,"Courier New")] | otherwise = []