diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/OpenDocument.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/OpenDocument.hs | 626 |
1 files changed, 626 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs new file mode 100644 index 000000000..851e18b8e --- /dev/null +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -0,0 +1,626 @@ +{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleContexts #-} +{- +Copyright (C) 2008-2015 Andrea Rossato <andrea.rossato@ing.unitn.it> + 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 <andrea.rossato@ing.unitn.it> + 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 = 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 (x@("style:rel-width", _) :xs) = x : getDims xs + getDims (x@("style:rel-height", _):xs) = x : 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 = [] |