From a8e2199034679c07411c76c42ab1ffb52b170029 Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Wed, 15 Aug 2007 06:00:58 +0000 Subject: Major code cleanup in all modules. (Removed unneeded imports, reformatted, etc.) More major changes are documented below: + Removed Text.Pandoc.ParserCombinators and moved all its definitions to Text.Pandoc.Shared. + In Text.Pandoc.Shared: - Removed unneeded 'try' in blanklines. - Removed endsWith function and rewrote functions to use isSuffixOf instead. - Added >>~ combinator. - Rewrote stripTrailingNewlines, removeLeadingSpaces. + Moved Text.Pandoc.Entities -> Text.Pandoc.CharacterReferences. - Removed unneeded functions charToEntity, charToNumericalEntity. - Renamed functions using proper terminology (character references, not entities). decodeEntities -> decodeCharacterReferences, characterEntity -> characterReference. - Moved escapeStringToXML to Docbook writer, which is the only thing that uses it. - Removed old entity parser in HTML and Markdown readers; replaced with new charRef parser in Text.Pandoc.Shared. + Fixed accent bug in Text.Pandoc.Readers.LaTeX: \^{} now correctly parses as a '^' character. + Text.Pandoc.ASCIIMathML is no longer an exported module. git-svn-id: https://pandoc.googlecode.com/svn/trunk@835 788f1e2b-df1e-0410-8736-df70ead52e1b --- src/Text/Pandoc/Writers/ConTeXt.hs | 23 +- src/Text/Pandoc/Writers/Docbook.hs | 199 +++++++-------- src/Text/Pandoc/Writers/HTML.hs | 475 ++++++++++++++++++------------------ src/Text/Pandoc/Writers/LaTeX.hs | 45 ++-- src/Text/Pandoc/Writers/Man.hs | 26 +- src/Text/Pandoc/Writers/Markdown.hs | 75 +++--- src/Text/Pandoc/Writers/RST.hs | 46 ++-- src/Text/Pandoc/Writers/RTF.hs | 94 ++++--- 8 files changed, 486 insertions(+), 497 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 1f93787b0..13912a9f3 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ConTeXt - Copyright : Copyright (C) 2006-7 John MacFarlane + Copyright : Copyright (C) 2007 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane @@ -27,9 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into ConTeXt. -} -module Text.Pandoc.Writers.ConTeXt ( - writeConTeXt - ) where +module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) @@ -40,8 +38,7 @@ type WriterState = Int -- number of next URL reference -- | Convert Pandoc to ConTeXt. writeConTeXt :: WriterOptions -> Pandoc -> String -writeConTeXt options document = - evalState (pandocToConTeXt options document) 1 +writeConTeXt options document = evalState (pandocToConTeXt options document) 1 pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc meta blocks) = do @@ -111,8 +108,8 @@ stringToConTeXt = concatMap escapeCharForConTeXt -- | Convert Pandoc block element to ConTeXt. blockToConTeXt :: Block -> State WriterState String blockToConTeXt Null = return "" -blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= (return . (++ "\n")) -blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= (return . (++ "\n\n")) +blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= return . (++ "\n") +blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= return . (++ "\n\n") blockToConTeXt (BlockQuote lst) = do contents <- blockListToConTeXt lst return $ "\\startblockquote\n" ++ contents ++ "\\stopblockquote\n\n" @@ -137,12 +134,12 @@ blockToConTeXt (OrderedList attribs lst) = case attribs of return $ "\\startitemize" ++ markerWidth' ++ "\n" ++ concat contents ++ "\\stopitemize\n" blockToConTeXt (DefinitionList lst) = - mapM defListItemToConTeXt lst >>= (return . (++ "\n") . concat) + mapM defListItemToConTeXt lst >>= return . (++ "\n") . concat blockToConTeXt HorizontalRule = return "\\thinrule\n\n" blockToConTeXt (Header level lst) = do contents <- inlineListToConTeXt lst - return $ if (level > 0) && (level <= 3) - then "\\" ++ (concat (replicate (level - 1) "sub")) ++ + return $ if level > 0 && level <= 3 + then "\\" ++ concat (replicate (level - 1) "sub") ++ "section{" ++ contents ++ "}\n\n" else contents ++ "\n\n" blockToConTeXt (Table caption aligns widths heads rows) = do @@ -186,12 +183,12 @@ defListItemToConTeXt (term, def) = do -- | Convert list of block elements to ConTeXt. blockListToConTeXt :: [Block] -> State WriterState String -blockListToConTeXt lst = mapM blockToConTeXt lst >>= (return . concat) +blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . concat -- | Convert list of inline elements to ConTeXt. inlineListToConTeXt :: [Inline] -- ^ Inlines to convert -> State WriterState String -inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= (return . concat) +inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . concat isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index ecd27ee0c..e34b1959c 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -30,16 +30,35 @@ Conversion of 'Pandoc' documents to Docbook XML. module Text.Pandoc.Writers.Docbook ( writeDocbook) where import Text.Pandoc.Definition import Text.Pandoc.Shared -import Text.Pandoc.Entities ( escapeStringForXML ) -import Data.Char ( toLower, ord ) -import Data.List ( isPrefixOf, partition, drop ) +import Data.List ( isPrefixOf, drop ) import Text.PrettyPrint.HughesPJ hiding ( Str ) - -- -- code to format XML -- +-- | Escape one character as needed for XML. +escapeCharForXML :: Char -> String +escapeCharForXML x = case x of + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\160' -> " " + c -> [c] + +-- | True if the character needs to be escaped. +needsEscaping :: Char -> Bool +needsEscaping c = c `elem` "&<>\"\160" + +-- | Escape string as needed for XML. Entity references are not preserved. +escapeStringForXML :: String -> String +escapeStringForXML "" = "" +escapeStringForXML str = + case break needsEscaping str of + (okay, "") -> okay + (okay, (c:cs)) -> okay ++ escapeCharForXML c ++ escapeStringForXML cs + -- | Return a text object with a string of formatted XML attributes. attributeList :: [(String, String)] -> Doc attributeList = text . concatMap @@ -52,10 +71,10 @@ inTags:: Bool -> String -> [(String, String)] -> Doc -> Doc inTags isIndented tagType attribs contents = let openTag = char '<' <> text tagType <> attributeList attribs <> char '>' - closeTag = text " text tagType <> char '>' in - if isIndented - then openTag $$ nest 2 contents $$ closeTag - else openTag <> contents <> closeTag + closeTag = text " text tagType <> char '>' + in if isIndented + then openTag $$ nest 2 contents $$ closeTag + else openTag <> contents <> closeTag -- | Return a self-closing tag of tagType with specified attributes selfClosingTag :: String -> [(String, String)] -> Doc @@ -79,42 +98,42 @@ authorToDocbook :: [Char] -> Doc authorToDocbook name = inTagsIndented "author" $ if ',' `elem` name then -- last name first - let (lastname, rest) = break (==',') name - firstname = removeLeadingSpace rest in - inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> - inTagsSimple "surname" (text $ escapeStringForXML lastname) + let (lastname, rest) = break (==',') name + firstname = removeLeadingSpace rest in + inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> + inTagsSimple "surname" (text $ escapeStringForXML lastname) else -- last name last - let namewords = words name - lengthname = length namewords - (firstname, lastname) = case lengthname of - 0 -> ("","") - 1 -> ("", name) - n -> (joinWithSep " " (take (n-1) namewords), last namewords) in - inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ - inTagsSimple "surname" (text $ escapeStringForXML lastname) + let namewords = words name + lengthname = length namewords + (firstname, lastname) = case lengthname of + 0 -> ("","") + 1 -> ("", name) + n -> (joinWithSep " " (take (n-1) namewords), last namewords) + in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ + inTagsSimple "surname" (text $ escapeStringForXML lastname) -- | Convert Pandoc document to string in Docbook format. writeDocbook :: WriterOptions -> Pandoc -> String writeDocbook opts (Pandoc (Meta title authors date) blocks) = - let head = if (writerStandalone opts) - then text (writerHeader opts) - else empty - meta = if (writerStandalone opts) - then inTagsIndented "articleinfo" $ - (inTagsSimple "title" (wrap opts title)) $$ - (vcat (map authorToDocbook authors)) $$ - (inTagsSimple "date" (text $ escapeStringForXML date)) - else empty + let head = if writerStandalone opts + then text (writerHeader opts) + else empty + meta = if writerStandalone opts + then inTagsIndented "articleinfo" $ + (inTagsSimple "title" (wrap opts title)) $$ + (vcat (map authorToDocbook authors)) $$ + (inTagsSimple "date" (text $ escapeStringForXML date)) + else empty elements = hierarchicalize blocks - before = writerIncludeBefore opts - after = writerIncludeAfter opts - body = (if null before then empty else text before) $$ - vcat (map (elementToDocbook opts) elements) $$ - (if null after then empty else text after) - body' = if writerStandalone opts - then inTagsIndented "article" (meta $$ body) - else body in - render $ head $$ body' $$ text "" + before = writerIncludeBefore opts + after = writerIncludeAfter opts + body = (if null before then empty else text before) $$ + vcat (map (elementToDocbook opts) elements) $$ + (if null after then empty else text after) + body' = if writerStandalone opts + then inTagsIndented "article" (meta $$ body) + else body + in render $ head $$ body' $$ text "" -- | Convert an Element to Docbook. elementToDocbook :: WriterOptions -> Element -> Doc @@ -123,10 +142,10 @@ elementToDocbook opts (Sec title elements) = -- Docbook doesn't allow sections with no content, so insert some if needed let elements' = if null elements then [Blk (Para [])] - else elements in - inTagsIndented "section" $ - inTagsSimple "title" (wrap opts title) $$ - vcat (map (elementToDocbook opts) elements') + else elements + in inTagsIndented "section" $ + inTagsSimple "title" (wrap opts title) $$ + vcat (map (elementToDocbook opts) elements') -- | Convert a list of Pandoc blocks to Docbook. blocksToDocbook :: WriterOptions -> [Block] -> Doc @@ -145,30 +164,27 @@ deflistItemsToDocbook opts items = -- | Convert a term and a list of blocks into a Docbook varlistentry. deflistItemToDocbook :: WriterOptions -> [Inline] -> [Block] -> Doc deflistItemToDocbook opts term def = - let def' = map plainToPara def in - inTagsIndented "varlistentry" $ - inTagsIndented "term" (inlinesToDocbook opts term) $$ - inTagsIndented "listitem" (blocksToDocbook opts def') + let def' = map plainToPara def + in inTagsIndented "varlistentry" $ + inTagsIndented "term" (inlinesToDocbook opts term) $$ + inTagsIndented "listitem" (blocksToDocbook opts def') -- | Convert a list of lists of blocks to a list of Docbook list items. listItemsToDocbook :: WriterOptions -> [[Block]] -> Doc -listItemsToDocbook opts items = - vcat $ map (listItemToDocbook opts) items +listItemsToDocbook opts items = vcat $ map (listItemToDocbook opts) items -- | Convert a list of blocks into a Docbook list item. listItemToDocbook :: WriterOptions -> [Block] -> Doc listItemToDocbook opts item = - let item' = map plainToPara item in - inTagsIndented "listitem" (blocksToDocbook opts item') + inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item -- | Convert a Pandoc block element to Docbook. blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook opts Null = empty blockToDocbook opts (Plain lst) = wrap opts lst -blockToDocbook opts (Para lst) = - inTagsIndented "para" (wrap opts lst) +blockToDocbook opts (Para lst) = inTagsIndented "para" $ wrap opts lst blockToDocbook opts (BlockQuote blocks) = - inTagsIndented "blockquote" (blocksToDocbook opts blocks) + inTagsIndented "blockquote" $ blocksToDocbook opts blocks blockToDocbook opts (CodeBlock str) = text "\n" <> text (escapeStringForXML str) <> text "\n" blockToDocbook opts (BulletList lst) = @@ -198,16 +214,16 @@ blockToDocbook opts (Table caption aligns widths headers rows) = then empty else inTagsIndented "caption" (inlinesToDocbook opts caption) - tableType = if isEmpty captionDoc then "informaltable" else "table" in - inTagsIndented tableType $ captionDoc $$ - (colHeadsToDocbook opts alignStrings widths headers) $$ - (vcat $ map (tableRowToDocbook opts alignStrings) rows) + tableType = if isEmpty captionDoc then "informaltable" else "table" + in inTagsIndented tableType $ captionDoc $$ + (colHeadsToDocbook opts alignStrings widths headers) $$ + (vcat $ map (tableRowToDocbook opts alignStrings) rows) colHeadsToDocbook opts alignStrings widths headers = - let heads = zipWith3 - (\align width item -> tableItemToDocbook opts "th" align width item) - alignStrings widths headers in - inTagsIndented "tr" $ vcat heads + let heads = zipWith3 (\align width item -> + tableItemToDocbook opts "th" align width item) + alignStrings widths headers + in inTagsIndented "tr" $ vcat heads alignmentToString alignment = case alignment of AlignLeft -> "left" @@ -215,20 +231,16 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" -tableRowToDocbook opts aligns cols = - inTagsIndented "tr" $ vcat $ zipWith3 (tableItemToDocbook opts "td") aligns (repeat 0) cols +tableRowToDocbook opts aligns cols = inTagsIndented "tr" $ + vcat $ zipWith3 (tableItemToDocbook opts "td") aligns (repeat 0) cols tableItemToDocbook opts tag align width item = let attrib = [("align", align)] ++ - if (width /= 0) - then [("style", "{width: " ++ - show (truncate (100*width)) ++ "%;}")] - else [] in - inTags True tag attrib $ vcat $ map (blockToDocbook opts) item - --- | Put string in CDATA section -cdata :: String -> Doc -cdata str = text $ "" + if width /= 0 + then [("style", "{width: " ++ + show (truncate (100*width)) ++ "%;}")] + else [] + in inTags True tag attrib $ vcat $ map (blockToDocbook opts) item -- | Take list of inline elements and return wrapped doc. wrap :: WriterOptions -> [Inline] -> Doc @@ -236,25 +248,24 @@ wrap opts lst = fsep $ map (inlinesToDocbook opts) (splitBy Space lst) -- | Convert a list of inline elements to Docbook. inlinesToDocbook :: WriterOptions -> [Inline] -> Doc -inlinesToDocbook opts lst = hcat (map (inlineToDocbook opts) lst) +inlinesToDocbook opts lst = hcat $ map (inlineToDocbook opts) lst -- | Convert an inline element to Docbook. inlineToDocbook :: WriterOptions -> Inline -> Doc inlineToDocbook opts (Str str) = text $ escapeStringForXML str inlineToDocbook opts (Emph lst) = - inTagsSimple "emphasis" (inlinesToDocbook opts lst) + inTagsSimple "emphasis" $ inlinesToDocbook opts lst inlineToDocbook opts (Strong lst) = - inTags False "emphasis" [("role", "strong")] - (inlinesToDocbook opts lst) + inTags False "emphasis" [("role", "strong")] $ inlinesToDocbook opts lst inlineToDocbook opts (Strikeout lst) = - inTags False "emphasis" [("role", "strikethrough")] - (inlinesToDocbook opts lst) + inTags False "emphasis" [("role", "strikethrough")] $ + inlinesToDocbook opts lst inlineToDocbook opts (Superscript lst) = - inTagsSimple "superscript" (inlinesToDocbook opts lst) + inTagsSimple "superscript" $ inlinesToDocbook opts lst inlineToDocbook opts (Subscript lst) = - inTagsSimple "subscript" (inlinesToDocbook opts lst) + inTagsSimple "subscript" $ inlinesToDocbook opts lst inlineToDocbook opts (Quoted _ lst) = - inTagsSimple "quote" (inlinesToDocbook opts lst) + inTagsSimple "quote" $ inlinesToDocbook opts lst inlineToDocbook opts Apostrophe = char '\'' inlineToDocbook opts Ellipses = text "…" inlineToDocbook opts EmDash = text "—" @@ -263,26 +274,24 @@ inlineToDocbook opts (Code str) = inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (TeX str) = inlineToDocbook opts (Code str) inlineToDocbook opts (HtmlInline str) = empty -inlineToDocbook opts LineBreak = - text $ "" +inlineToDocbook opts LineBreak = text $ "" inlineToDocbook opts Space = char ' ' inlineToDocbook opts (Link txt (src, tit)) = if isPrefixOf "mailto:" src - then let src' = drop 7 src - emailLink = inTagsSimple "email" $ text (escapeStringForXML $ src') - in if txt == [Code src'] - then emailLink - else inlinesToDocbook opts txt <+> char '(' <> emailLink <> - char ')' - else inTags False "ulink" [("url", src)] $ inlinesToDocbook opts txt + then let src' = drop 7 src + emailLink = inTagsSimple "email" $ text $ + escapeStringForXML $ src' + in if txt == [Code src'] + then emailLink + else inlinesToDocbook opts txt <+> char '(' <> emailLink <> + char ')' + else inTags False "ulink" [("url", src)] $ inlinesToDocbook opts txt inlineToDocbook opts (Image alt (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ - inTagsIndented "title" - (text $ escapeStringForXML tit) in - inTagsIndented "inlinemediaobject" $ - inTagsIndented "imageobject" $ - titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] + inTagsIndented "title" (text $ escapeStringForXML tit) + in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ + titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] inlineToDocbook opts (Note contents) = inTagsIndented "footnote" $ blocksToDocbook opts contents diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 34c59f334..ace5cfe5f 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -27,15 +27,15 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to HTML. -} -module Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString ) where +module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition import Text.Pandoc.ASCIIMathML +import Text.Pandoc.CharacterReferences ( decodeCharacterReferences ) import Text.Pandoc.Shared -import Text.Pandoc.Entities (decodeEntities) import Text.Regex ( mkRegex, matchRegex ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) -import Data.List ( isPrefixOf, partition, intersperse ) +import Data.List ( isPrefixOf, intersperse ) import qualified Data.Set as S import Control.Monad.State import Text.XHtml.Transitional @@ -55,8 +55,8 @@ defaultWriterState = WriterState {stNotes= [], stIds = [], writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts = if writerStandalone opts - then renderHtml . (writeHtml opts) - else renderHtmlFragment . (writeHtml opts) + then renderHtml . writeHtml opts + else renderHtmlFragment . writeHtml opts -- | Convert Pandoc document to Html structure. writeHtml :: WriterOptions -> Pandoc -> Html @@ -74,49 +74,51 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) = map (\a -> meta ! [name "author", content a]) authors) +++ (if null date then noHtml - else meta ! [name "date", content date]) - titleHeader = if (writerStandalone opts) && (not (null tit)) && - (not (writerS5 opts)) + else meta ! [name "date", content date]) + titleHeader = if writerStandalone opts && not (null tit) && + not (writerS5 opts) then h1 ! [theclass "title"] $ topTitle else noHtml headerBlocks = filter isHeaderBlock blocks - ids = uniqueIdentifiers $ map (\(Header _ lst) -> lst) headerBlocks - toc = if writerTableOfContents opts - then tableOfContents opts headerBlocks ids - else noHtml + ids = uniqueIdentifiers $ + map (\(Header _ lst) -> lst) headerBlocks + toc = if writerTableOfContents opts + then tableOfContents opts headerBlocks ids + else noHtml (blocks', newstate) = - runState (blockListToHtml opts blocks) - (defaultWriterState {stIds = ids}) - cssLines = stCSS newstate - css = if S.null cssLines - then noHtml - else style ! [thetype "text/css"] $ primHtml $ - '\n':(unlines $ S.toList cssLines) - math = if stMath newstate - then case writerASCIIMathMLURL opts of - Just path -> script ! [src path, - thetype "text/javascript"] $ noHtml - Nothing -> primHtml asciiMathMLScript - else noHtml - head = header $ metadata +++ math +++ css +++ - primHtml (writerHeader opts) - notes = reverse (stNotes newstate) - before = primHtml $ writerIncludeBefore opts - after = primHtml $ writerIncludeAfter opts - thebody = before +++ titleHeader +++ toc +++ blocks' +++ - footnoteSection opts notes +++ after + runState (blockListToHtml opts blocks) + (defaultWriterState {stIds = ids}) + cssLines = stCSS newstate + css = if S.null cssLines + then noHtml + else style ! [thetype "text/css"] $ primHtml $ + '\n':(unlines $ S.toList cssLines) + math = if stMath newstate + then case writerASCIIMathMLURL opts of + Just path -> script ! [src path, + thetype "text/javascript"] $ + noHtml + Nothing -> primHtml asciiMathMLScript + else noHtml + head = header $ metadata +++ math +++ css +++ + primHtml (writerHeader opts) + notes = reverse (stNotes newstate) + before = primHtml $ writerIncludeBefore opts + after = primHtml $ writerIncludeAfter opts + thebody = before +++ titleHeader +++ toc +++ blocks' +++ + footnoteSection opts notes +++ after in if writerStandalone opts - then head +++ (body thebody) + then head +++ body thebody else thebody -- | Construct table of contents from list of header blocks and identifiers. -- Assumes there are as many identifiers as header blocks. tableOfContents :: WriterOptions -> [Block] -> [String] -> Html tableOfContents opts headers ids = - let opts' = opts { writerIgnoreNotes = True } + let opts' = opts { writerIgnoreNotes = True } contentsTree = hierarchicalize headers - contents = evalState (mapM (elementToListItem opts') contentsTree) - (defaultWriterState {stIds = ids}) + contents = evalState (mapM (elementToListItem opts') contentsTree) + (defaultWriterState {stIds = ids}) in thediv ! [identifier "toc"] $ unordList contents -- | Converts an Element to a list item for a table of contents, @@ -135,7 +137,8 @@ elementToListItem opts (Sec headerText subsecs) = do let subList = if null subHeads then noHtml else unordList subHeads - return $ (anchor ! [href ("#" ++ id), identifier ("TOC-" ++ id)] $ txt) +++ subList + return $ (anchor ! [href ("#" ++ id), identifier ("TOC-" ++ id)] $ txt) +++ + subList -- | Convert list of Note blocks to a footnote
. -- Assumes notes are sorted. @@ -143,62 +146,61 @@ footnoteSection :: WriterOptions -> [Html] -> Html footnoteSection opts notes = if null notes then noHtml - else thediv ! [theclass "footnotes"] $ - hr +++ (olist << notes) + else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes) -- | Obfuscate a "mailto:" link using Javascript. obfuscateLink :: WriterOptions -> String -> String -> Html obfuscateLink opts text src = let emailRegex = mkRegex "^mailto:([^@]*)@(.*)$" - src' = map toLower src in - case (matchRegex emailRegex src') of - (Just [name, domain]) -> - let domain' = substitute "." " dot " domain - at' = obfuscateChar '@' - (linkText, altText) = - if text == drop 7 src' -- autolink - then ("''+e+''", name ++ " at " ++ domain') - else ("'" ++ text ++ "'", text ++ " (" ++ name ++ " at " ++ - domain' ++ ")") in - if writerStrictMarkdown opts - then -- need to use primHtml or &'s are escaped to & in URL - primHtml $ "" ++ (obfuscateString text) ++ "" - else (script ! [thetype "text/javascript"] $ - primHtml ("\n\n")) +++ - noscript (primHtml $ obfuscateString altText) - _ -> anchor ! [href src] $ primHtml text -- malformed email + src' = map toLower src + in case (matchRegex emailRegex src') of + (Just [name, domain]) -> + let domain' = substitute "." " dot " domain + at' = obfuscateChar '@' + (linkText, altText) = + if text == drop 7 src' -- autolink + then ("''+e+''", name ++ " at " ++ domain') + else ("'" ++ text ++ "'", text ++ " (" ++ name ++ " at " ++ + domain' ++ ")") + in if writerStrictMarkdown opts + then -- need to use primHtml or &'s are escaped to & in URL + primHtml $ "" ++ (obfuscateString text) ++ "" + else (script ! [thetype "text/javascript"] $ + primHtml ("\n\n")) +++ + noscript (primHtml $ obfuscateString altText) + _ -> anchor ! [href src] $ primHtml text -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String obfuscateChar char = - let num = ord char in - let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in - "&#" ++ numstr ++ ";" + let num = ord char + numstr = if even num then show num else "x" ++ showHex num "" + in "&#" ++ numstr ++ ";" -- | Obfuscate string using entities. obfuscateString :: String -> String -obfuscateString = (concatMap obfuscateChar) . decodeEntities +obfuscateString = concatMap obfuscateChar . decodeCharacterReferences -- | True if character is a punctuation character (unicode). isPunctuation :: Char -> Bool isPunctuation c = - let c' = ord c in - if (c `elem` "!\"'()*,-./:;<>?[\\]`{|}~") || (c' >= 0x2000 && c' <= 0x206F) || - (c' >= 0xE000 && c' <= 0xE0FF) - then True - else False + let c' = ord c + in if c `elem` "!\"'()*,-./:;<>?[\\]`{|}~" || c' >= 0x2000 && c' <= 0x206F || + c' >= 0xE000 && c' <= 0xE0FF + then True + else False -- | Add CSS for document header. addToCSS :: String -> State WriterState () addToCSS item = do st <- get let current = stCSS st - put $ st {stCSS = (S.insert item current)} + put $ st {stCSS = S.insert item current} -- | Convert Pandoc inline list to plain text identifier. inlineListToIdentifier :: [Inline] -> String @@ -206,27 +208,26 @@ inlineListToIdentifier [] = "" inlineListToIdentifier (x:xs) = xAsText ++ inlineListToIdentifier xs where xAsText = case x of - Str s -> filter - (\c -> (c == '-') || not (isPunctuation c)) $ - concat $ intersperse "-" $ words $ map toLower s - Emph lst -> inlineListToIdentifier lst - Strikeout lst -> inlineListToIdentifier lst - Superscript lst -> inlineListToIdentifier lst - Subscript lst -> inlineListToIdentifier lst - Strong lst -> inlineListToIdentifier lst - Quoted _ lst -> inlineListToIdentifier lst - Code s -> s - Space -> "-" - EmDash -> "-" - EnDash -> "-" - Apostrophe -> "" - Ellipses -> "" - LineBreak -> "-" - TeX _ -> "" - HtmlInline _ -> "" - Link lst _ -> inlineListToIdentifier lst - Image lst _ -> inlineListToIdentifier lst - Note _ -> "" + Str s -> filter (\c -> c == '-' || not (isPunctuation c)) $ + concat $ intersperse "-" $ words $ map toLower s + Emph lst -> inlineListToIdentifier lst + Strikeout lst -> inlineListToIdentifier lst + Superscript lst -> inlineListToIdentifier lst + Subscript lst -> inlineListToIdentifier lst + Strong lst -> inlineListToIdentifier lst + Quoted _ lst -> inlineListToIdentifier lst + Code s -> s + Space -> "-" + EmDash -> "-" + EnDash -> "-" + Apostrophe -> "" + Ellipses -> "" + LineBreak -> "-" + TeX _ -> "" + HtmlInline _ -> "" + Link lst _ -> inlineListToIdentifier lst + Image lst _ -> inlineListToIdentifier lst + Note _ -> "" -- | Return unique identifiers for list of inline lists. uniqueIdentifiers :: [[Inline]] -> [String] @@ -236,102 +237,99 @@ uniqueIdentifiers ls = matches = length $ filter (== new) nonuniqueIds new' = new ++ if matches > 0 then ("-" ++ show matches) else "" in (new:nonuniqueIds, new':uniqueIds) - in reverse $ snd (foldl addIdentifier ([],[]) $ ls) + in reverse $ snd $ foldl addIdentifier ([],[]) ls -- | Convert Pandoc block element to HTML. blockToHtml :: WriterOptions -> Block -> State WriterState Html -blockToHtml opts block = - case block of - (Null) -> return $ noHtml - (Plain lst) -> inlineListToHtml opts lst - (Para lst) -> inlineListToHtml opts lst >>= (return . paragraph) - (RawHtml str) -> return $ primHtml str - (HorizontalRule) -> return $ hr - (CodeBlock str) -> return $ pre $ thecode << (str ++ "\n") +blockToHtml opts Null = return $ noHtml +blockToHtml opts (Plain lst) = inlineListToHtml opts lst +blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph) +blockToHtml opts (RawHtml str) = return $ primHtml str +blockToHtml opts (HorizontalRule) = return $ hr +blockToHtml opts (CodeBlock str) = return $ pre $ thecode << (str ++ "\n") -- the final \n for consistency with Markdown.pl - (BlockQuote blocks) -> -- in S5, treat list in blockquote specially - -- if default is incremental, make it nonincremental; - -- otherwise incremental - if writerS5 opts - then let inc = not (writerIncremental opts) in - case blocks of - [BulletList lst] -> blockToHtml (opts {writerIncremental = inc}) - (BulletList lst) - [OrderedList attribs lst] -> - blockToHtml (opts {writerIncremental = inc}) - (OrderedList attribs lst) - otherwise -> blockListToHtml opts blocks >>= - (return . blockquote) - else blockListToHtml opts blocks >>= (return . blockquote) - (Header level lst) -> do contents <- inlineListToHtml opts lst - st <- get - let ids = stIds st - let (id, rest) = if null ids - then ("", []) - else (head ids, tail ids) - put $ st {stIds = rest} - let attribs = [identifier id] - let headerHtml = case level of - 1 -> h1 contents ! attribs - 2 -> h2 contents ! attribs - 3 -> h3 contents ! attribs - 4 -> h4 contents ! attribs - 5 -> h5 contents ! attribs - 6 -> h6 contents ! attribs - _ -> paragraph contents ! attribs - let headerHtml' = if writerTableOfContents opts - then anchor ! [href ("#TOC-" ++ id)] $ - headerHtml - else headerHtml - return headerHtml' - (BulletList lst) -> do contents <- mapM (blockListToHtml opts) lst - let attribs = if writerIncremental opts - then [theclass "incremental"] - else [] - return $ unordList ! attribs $ contents - (OrderedList (startnum, numstyle, _) lst) -> do - contents <- mapM (blockListToHtml opts) lst - let numstyle' = camelCaseToHyphenated $ show numstyle - let attribs = (if writerIncremental opts - then [theclass "incremental"] - else []) ++ - (if startnum /= 1 - then [start startnum] - else []) ++ - (if numstyle /= DefaultStyle - then [theclass numstyle'] - else []) - if numstyle /= DefaultStyle - then addToCSS $ "ol." ++ numstyle' ++ - " { list-style-type: " ++ - numstyle' ++ "; }" - else return () - return $ ordList ! attribs $ contents - (DefinitionList lst) -> do contents <- mapM (\(term, def) -> - do term' <- inlineListToHtml opts term - def' <- blockListToHtml opts def - return $ (term', def')) - lst - let attribs = if writerIncremental opts - then [theclass "incremental"] - else [] - return $ defList ! attribs $ contents - (Table capt aligns widths headers rows) -> - do let alignStrings = map alignmentToString aligns - captionDoc <- if null capt - then return noHtml - else inlineListToHtml opts capt >>= - (return . caption) - colHeads <- colHeadsToHtml opts alignStrings - widths headers - rows' <- mapM (tableRowToHtml opts alignStrings) rows - return $ table $ captionDoc +++ colHeads +++ rows' +blockToHtml opts (BlockQuote blocks) = + -- in S5, treat list in blockquote specially + -- if default is incremental, make it nonincremental; + -- otherwise incremental + if writerS5 opts + then let inc = not (writerIncremental opts) in + case blocks of + [BulletList lst] -> blockToHtml (opts {writerIncremental = inc}) + (BulletList lst) + [OrderedList attribs lst] -> + blockToHtml (opts {writerIncremental = inc}) + (OrderedList attribs lst) + otherwise -> blockListToHtml opts blocks >>= + (return . blockquote) + else blockListToHtml opts blocks >>= (return . blockquote) +blockToHtml opts (Header level lst) = do + contents <- inlineListToHtml opts lst + st <- get + let ids = stIds st + let (id, rest) = if null ids + then ("", []) + else (head ids, tail ids) + put $ st {stIds = rest} + let attribs = [identifier id] + let headerHtml = case level of + 1 -> h1 contents ! attribs + 2 -> h2 contents ! attribs + 3 -> h3 contents ! attribs + 4 -> h4 contents ! attribs + 5 -> h5 contents ! attribs + 6 -> h6 contents ! attribs + _ -> paragraph contents ! attribs + return $ if writerTableOfContents opts + then anchor ! [href ("#TOC-" ++ id)] $ headerHtml + else headerHtml +blockToHtml opts (BulletList lst) = do + contents <- mapM (blockListToHtml opts) lst + let attribs = if writerIncremental opts + then [theclass "incremental"] + else [] + return $ unordList ! attribs $ contents +blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do + contents <- mapM (blockListToHtml opts) lst + let numstyle' = camelCaseToHyphenated $ show numstyle + let attribs = (if writerIncremental opts + then [theclass "incremental"] + else []) ++ + (if startnum /= 1 + then [start startnum] + else []) ++ + (if numstyle /= DefaultStyle + then [theclass numstyle'] + else []) + if numstyle /= DefaultStyle + then addToCSS $ "ol." ++ numstyle' ++ + " { list-style-type: " ++ + numstyle' ++ "; }" + else return () + return $ ordList ! attribs $ contents +blockToHtml opts (DefinitionList lst) = do + contents <- mapM (\(term, def) -> do term' <- inlineListToHtml opts term + def' <- blockListToHtml opts def + return $ (term', def')) lst + let attribs = if writerIncremental opts + then [theclass "incremental"] + else [] + return $ defList ! attribs $ contents +blockToHtml opts (Table capt aligns widths headers rows) = do + let alignStrings = map alignmentToString aligns + captionDoc <- if null capt + then return noHtml + else inlineListToHtml opts capt >>= return . caption + colHeads <- colHeadsToHtml opts alignStrings + widths headers + rows' <- mapM (tableRowToHtml opts alignStrings) rows + return $ table $ captionDoc +++ colHeads +++ rows' -colHeadsToHtml opts alignStrings widths headers = - do heads <- sequence $ zipWith3 - (\align width item -> tableItemToHtml opts th align width item) - alignStrings widths headers - return $ tr $ toHtmlFromList heads +colHeadsToHtml opts alignStrings widths headers = do + heads <- sequence $ zipWith3 + (\align width item -> tableItemToHtml opts th align width item) + alignStrings widths headers + return $ tr $ toHtmlFromList heads alignmentToString alignment = case alignment of AlignLeft -> "left" @@ -339,24 +337,27 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" -tableRowToHtml opts aligns cols = - do contents <- sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols - return $ tr $ toHtmlFromList contents +tableRowToHtml opts aligns cols = + (sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols) >>= + return . tr . toHtmlFromList -tableItemToHtml opts tag align' width item = - do contents <- blockListToHtml opts item - let attrib = [align align'] ++ - if (width /= 0) - then [thestyle ("{width: " ++ show (truncate (100*width)) ++ "%;}")] - else [] - return $ tag ! attrib $ contents +tableItemToHtml opts tag align' width item = do + contents <- blockListToHtml opts item + let attrib = [align align'] ++ + if width /= 0 + then [thestyle ("{width: " ++ show (truncate (100*width)) ++ + "%;}")] + else [] + return $ tag ! attrib $ contents blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html -blockListToHtml opts lst = mapM (blockToHtml opts) lst >>= (return . toHtmlFromList) +blockListToHtml opts lst = + mapM (blockToHtml opts) lst >>= return . toHtmlFromList -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: WriterOptions -> [Inline] -> State WriterState Html -inlineListToHtml opts lst = mapM (inlineToHtml opts) lst >>= (return . toHtmlFromList) +inlineListToHtml opts lst = + mapM (inlineToHtml opts) lst >>= return . toHtmlFromList -- | Convert Pandoc inline element to HTML. inlineToHtml :: WriterOptions -> Inline -> State WriterState Html @@ -369,52 +370,58 @@ inlineToHtml opts inline = (EnDash) -> return $ primHtmlChar "ndash" (Ellipses) -> return $ primHtmlChar "hellip" (Apostrophe) -> return $ primHtmlChar "rsquo" - (Emph lst) -> inlineListToHtml opts lst >>= (return . emphasize) - (Strong lst) -> inlineListToHtml opts lst >>= (return . strong) + (Emph lst) -> inlineListToHtml opts lst >>= return . emphasize + (Strong lst) -> inlineListToHtml opts lst >>= return . strong (Code str) -> return $ thecode << str - (Strikeout lst) -> addToCSS ".strikeout { text-decoration: line-through; }" >> + (Strikeout lst) -> addToCSS + ".strikeout { text-decoration: line-through; }" >> inlineListToHtml opts lst >>= - (return . (thespan ! [theclass "strikeout"])) - (Superscript lst) -> inlineListToHtml opts lst >>= (return . sup) - (Subscript lst) -> inlineListToHtml opts lst >>= (return . sub) + return . (thespan ! [theclass "strikeout"]) + (Superscript lst) -> inlineListToHtml opts lst >>= return . sup + (Subscript lst) -> inlineListToHtml opts lst >>= return . sub (Quoted quoteType lst) -> let (leftQuote, rightQuote) = case quoteType of SingleQuote -> (primHtmlChar "lsquo", primHtmlChar "rsquo") DoubleQuote -> (primHtmlChar "ldquo", - primHtmlChar "rdquo") in - do contents <- inlineListToHtml opts lst - return $ leftQuote +++ contents +++ rightQuote - (TeX str) -> do if writerUseASCIIMathML opts - then modify (\st -> st {stMath = True}) - else return () - return $ stringToHtml str + primHtmlChar "rdquo") + in do contents <- inlineListToHtml opts lst + return $ leftQuote +++ contents +++ rightQuote + (TeX str) -> (if writerUseASCIIMathML opts + then modify (\st -> st {stMath = True}) + else return ()) >> return (stringToHtml str) (HtmlInline str) -> return $ primHtml str (Link [Code str] (src,tit)) | "mailto:" `isPrefixOf` src -> - do return $ obfuscateLink opts str src - (Link txt (src,tit)) | "mailto:" `isPrefixOf` src -> - do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts (show linkText) src - (Link txt (src,tit)) -> - do linkText <- inlineListToHtml opts txt - return $ anchor ! ([href src] ++ - if null tit then [] else [title tit]) $ linkText - (Image txt (source,tit)) -> - do alternate <- inlineListToHtml opts txt - let alternate' = renderHtmlFragment alternate - let attributes = [src source, title tit] ++ - if null txt then [] else [alt alternate'] - return $ image ! attributes - -- note: null title included, as in Markdown.pl - (Note contents) -> do st <- get - let notes = stNotes st - let number = (length notes) + 1 - let ref = show number - htmlContents <- blockListToNote opts ref contents - put $ st {stNotes = (htmlContents:notes)} -- push contents onto front of notes - return $ anchor ! [href ("#fn" ++ ref), - theclass "footnoteRef", - identifier ("fnref" ++ ref)] << sup << ref + return $ obfuscateLink opts str src + (Link txt (src,tit)) | "mailto:" `isPrefixOf` src -> do + linkText <- inlineListToHtml opts txt + return $ obfuscateLink opts (show linkText) src + (Link txt (src,tit)) -> do + linkText <- inlineListToHtml opts txt + return $ anchor ! ([href src] ++ + if null tit then [] else [title tit]) $ + linkText + (Image txt (source,tit)) -> do + alternate <- inlineListToHtml opts txt + let alternate' = renderHtmlFragment alternate + let attributes = [src source, title tit] ++ + if null txt + then [] + else [alt alternate'] + return $ image ! attributes + -- note: null title included, as in Markdown.pl + (Note contents) -> do + st <- get + let notes = stNotes st + let number = (length notes) + 1 + let ref = show number + htmlContents <- blockListToNote opts ref contents + -- push contents onto front of notes + put $ st {stNotes = (htmlContents:notes)} + return $ anchor ! [href ("#fn" ++ ref), + theclass "footnoteRef", + identifier ("fnref" ++ ref)] << + sup << ref blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html blockListToNote opts ref blocks = @@ -434,6 +441,6 @@ blockListToNote opts ref blocks = [Plain (lst ++ backlink)] _ -> otherBlocks ++ [lastBlock, Plain backlink] - in do contents <- blockListToHtml opts blocks' - return $ li ! [identifier ("fn" ++ ref)] $ contents + in do contents <- blockListToHtml opts blocks' + return $ li ! [identifier ("fn" ++ ref)] $ contents diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 3d0c66e45..ad1f3e45f 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -27,16 +27,14 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' format into LaTeX. -} -module Text.Pandoc.Writers.LaTeX ( - writeLaTeX - ) where +module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) import Data.List ( (\\), isInfixOf ) +import Data.Char ( toLower ) import qualified Data.Set as S import Control.Monad.State -import Data.Char ( toLower ) data WriterState = WriterState { stIncludes :: S.Set String -- strings to include in header @@ -77,16 +75,16 @@ latexHeader :: WriterOptions -- ^ Options, including LaTeX header -> Meta -- ^ Meta with bibliographic information -> State WriterState String latexHeader options (Meta title authors date) = do - titletext <- if null title - then return "" - else do title' <- inlineListToLaTeX title - return $ "\\title{" ++ title' ++ "}\n" - extras <- get >>= (return . unlines . S.toList. stIncludes) + titletext <- if null title + then return "" + else do title' <- inlineListToLaTeX title + return $ "\\title{" ++ title' ++ "}\n" + extras <- get >>= (return . unlines . S.toList. stIncludes) let verbatim = if "\\usepackage{fancyvrb}" `isInfixOf` extras then "\\VerbatimFootnotes % allows verbatim text in footnotes\n" else "" - let authorstext = "\\author{" ++ (joinWithSep "\\\\" - (map stringToLaTeX authors)) ++ "}\n" + let authorstext = "\\author{" ++ + joinWithSep "\\\\" (map stringToLaTeX authors) ++ "}\n" let datetext = if date == "" then "" else "\\date{" ++ stringToLaTeX date ++ "}\n" @@ -124,8 +122,8 @@ deVerb (other:rest) = other:(deVerb rest) blockToLaTeX :: Block -- ^ Block to convert -> State WriterState String blockToLaTeX Null = return "" -blockToLaTeX (Plain lst) = (inlineListToLaTeX lst) >>= (return . (++ "\n")) -blockToLaTeX (Para lst) = (inlineListToLaTeX lst) >>= (return . (++ "\n\n")) +blockToLaTeX (Plain lst) = inlineListToLaTeX lst >>= return . (++ "\n") +blockToLaTeX (Para lst) = inlineListToLaTeX lst >>= return . (++ "\n\n") blockToLaTeX (BlockQuote lst) = do contents <- blockListToLaTeX lst return $ "\\begin{quote}\n" ++ contents ++ "\\end{quote}\n" @@ -184,22 +182,22 @@ blockToLaTeX (Table caption aligns widths heads rows) = do colWidths aligns let tableBody = "\\begin{tabular}{" ++ colDescriptors ++ "}\n" ++ headers ++ "\\hline\n" ++ concat rows' ++ "\\end{tabular}\n" - let centered str = "\\begin{center}\n" ++ str ++ "\\end{center}\n" + let centered str = "\\begin{center}\n" ++ str ++ "\\end{center}\n" addToHeader "\\usepackage{array}\n\ - \% This is needed because raggedright in table elements redefines \\\\:\n\ - \\\newcommand{\\PreserveBackslash}[1]{\\let\\temp=\\\\#1\\let\\\\=\\temp}\n\ - \\\let\\PBS=\\PreserveBackslash" + \% This is needed because raggedright in table elements redefines \\\\:\n\ + \\\newcommand{\\PreserveBackslash}[1]{\\let\\temp=\\\\#1\\let\\\\=\\temp}\n\ + \\\let\\PBS=\\PreserveBackslash" return $ if null captionText then centered tableBody ++ "\n" - else "\\begin{table}[h]\n" ++ centered tableBody ++ "\\caption{" ++ - captionText ++ "}\n" ++ "\\end{table}\n\n" + else "\\begin{table}[h]\n" ++ centered tableBody ++ + "\\caption{" ++ captionText ++ "}\n" ++ "\\end{table}\n\n" -blockListToLaTeX lst = mapM blockToLaTeX lst >>= (return . concat) +blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . concat tableRowToLaTeX cols = - mapM blockListToLaTeX cols >>= (return . (++ "\\\\\n") . (joinWithSep " & ")) + mapM blockListToLaTeX cols >>= return . (++ "\\\\\n") . (joinWithSep " & ") -listItemToLaTeX lst = blockListToLaTeX lst >>= (return . ("\\item "++)) +listItemToLaTeX lst = blockListToLaTeX lst >>= return . ("\\item "++) defListItemToLaTeX (term, def) = do term' <- inlineListToLaTeX $ deVerb term @@ -209,8 +207,7 @@ defListItemToLaTeX (term, def) = do -- | Convert list of inline elements to LaTeX. inlineListToLaTeX :: [Inline] -- ^ Inlines to convert -> State WriterState String -inlineListToLaTeX lst = - mapM inlineToLaTeX lst >>= (return . concat) +inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . concat isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 3232a454a..b9596dc2d 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -28,14 +28,11 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to groff man page format. -} -module Text.Pandoc.Writers.Man ( - writeMan - ) where +module Text.Pandoc.Writers.Man ( writeMan) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) -import Data.Char ( toUpper ) -import Data.List ( group, isPrefixOf, drop, find, nub, intersperse ) +import Data.List ( isPrefixOf, drop, nub, intersperse ) import Text.PrettyPrint.HughesPJ hiding ( Str ) import Control.Monad.State @@ -45,16 +42,15 @@ type WriterState = (Notes, Preprocessors) -- | Convert Pandoc to Man. writeMan :: WriterOptions -> Pandoc -> String -writeMan opts document = - render $ evalState (pandocToMan opts document) ([],[]) +writeMan opts document = render $ evalState (pandocToMan opts document) ([],[]) -- | Return groff man representation of document. pandocToMan :: WriterOptions -> Pandoc -> State WriterState Doc pandocToMan opts (Pandoc meta blocks) = do let before = writerIncludeBefore opts let after = writerIncludeAfter opts - before' = if null before then empty else text before - after' = if null after then empty else text after + let before' = if null before then empty else text before + let after' = if null after then empty else text after (head, foot) <- metaToMan opts meta body <- blockListToMan opts blocks (notes, preprocessors) <- get @@ -84,8 +80,8 @@ metaToMan options (Meta title authors date) = do 1 -> text ".SH AUTHOR" $$ (text $ joinWithSep ", " authors) 2 -> text ".SH AUTHORS" $$ (text $ joinWithSep ", " authors) return $ if writerStandalone options - then (head, foot) - else (empty, empty) + then (head, foot) + else (empty, empty) -- | Return man representation of notes. notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc @@ -93,7 +89,7 @@ notesToMan opts notes = if null notes then return empty else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>= - (return . (text ".SH NOTES" $$) . vcat) + return . (text ".SH NOTES" $$) . vcat -- | Return man representation of a note. noteToMan :: WriterOptions -> Int -> [Block] -> State WriterState Doc @@ -110,8 +106,7 @@ wrappedMan opts sect = do -- | Association list of characters to escape. manEscapes :: [(Char, String)] -manEscapes = [('\160', "\\ "), ('\'', "\\[aq]")] ++ - backslashEscapes "\".@\\" +manEscapes = [('\160', "\\ "), ('\'', "\\[aq]")] ++ backslashEscapes "\".@\\" -- | Escape special characters for Man. escapeString :: String -> String @@ -140,8 +135,7 @@ blockToMan opts (Header level inlines) = do return $ text heading <> contents blockToMan opts (CodeBlock str) = return $ text ".PP" $$ text "\\f[CR]" $$ - text ((unlines . map (" " ++) . lines) (escapeCode str)) <> - text "\\f[]" + text ((unlines . map (" " ++) . lines) (escapeCode str)) <> text "\\f[]" blockToMan opts (BlockQuote blocks) = do contents <- blockListToMan opts blocks return $ text ".RS" $$ contents $$ text ".RE" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index eb633166d..e7acd762c 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -29,9 +29,7 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text. Markdown: -} -module Text.Pandoc.Writers.Markdown ( - writeMarkdown - ) where +module Text.Pandoc.Writers.Markdown ( writeMarkdown) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.Blocks @@ -53,10 +51,10 @@ pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState Doc pandocToMarkdown opts (Pandoc meta blocks) = do let before = writerIncludeBefore opts let after = writerIncludeAfter opts - before' = if null before then empty else text before - after' = if null after then empty else text after + let before' = if null before then empty else text before + let after' = if null after then empty else text after metaBlock <- metaToMarkdown opts meta - let head = if (writerStandalone opts) + let head = if writerStandalone opts then metaBlock $+$ text (writerHeader opts) else empty let headerBlocks = filter isHeaderBlock blocks @@ -73,8 +71,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do -- | Return markdown representation of reference key table. keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc -keyTableToMarkdown opts refs = - mapM (keyToMarkdown opts) refs >>= (return . vcat) +keyTableToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat -- | Return markdown representation of a reference key. keyToMarkdown :: WriterOptions @@ -90,7 +87,7 @@ keyToMarkdown opts (label, (src, tit)) = do notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc notesToMarkdown opts notes = mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>= - (return . vcat) + return . vcat -- | Return markdown representation of a note. noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc @@ -143,8 +140,7 @@ tableOfContents opts headers = -- | Converts an Element to a list item for a table of contents, elementToListItem :: Element -> [Block] elementToListItem (Blk _) = [] -elementToListItem (Sec headerText subsecs) = - [Plain headerText] ++ +elementToListItem (Sec headerText subsecs) = [Plain headerText] ++ if null subsecs then [] else [BulletList $ map elementToListItem subsecs] @@ -184,9 +180,8 @@ blockToMarkdown opts (Table caption aligns widths headers rows) = do let makeRow = hsepBlocks . (zipWith alignHeader aligns) . (zipWith docToBlock widthsInChars) let head = makeRow headers' - rows' <- mapM (\row -> do - cols <- mapM (blockListToMarkdown opts) row - return $ makeRow cols) rows + rows' <- mapM (\row -> do cols <- mapM (blockListToMarkdown opts) row + return $ makeRow cols) rows let tableWidth = sum widthsInChars let maxRowHeight = maximum $ map heightOfBlock (head:rows') let isMultilineTable = maxRowHeight > 1 @@ -208,8 +203,7 @@ blockToMarkdown opts (OrderedList attribs items) = do let markers = orderedListMarkers attribs let markers' = map (\m -> if length m < 3 then m ++ replicate (3 - length m) ' ' - else m) - markers + else m) markers contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $ zip markers' items return $ (vcat contents) <> text "\n" @@ -241,8 +235,8 @@ definitionListItemToMarkdown opts (label, items) = do let tabStop = writerTabStop opts let leader = char ':' contents <- mapM (\item -> blockToMarkdown opts item >>= - (\txt -> return (leader $$ nest tabStop txt))) - items >>= (return . vcat) + (\txt -> return (leader $$ nest tabStop txt))) + items >>= return . vcat return $ labelText $+$ contents -- | Convert list of Pandoc block elements to markdown. @@ -250,29 +244,30 @@ blockListToMarkdown :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements -> State WriterState Doc blockListToMarkdown opts blocks = - mapM (blockToMarkdown opts) blocks >>= (return . vcat) + mapM (blockToMarkdown opts) blocks >>= return . vcat -- | Get reference for target; if none exists, create unique one and return. -- Prefer label if possible; otherwise, generate a unique key. getReference :: [Inline] -> Target -> State WriterState [Inline] getReference label (src, tit) = do - (_,refs) <- get - case find ((== (src, tit)) . snd) refs of - Just (ref, _) -> return ref - Nothing -> do - let label' = case find ((== label) . fst) refs of - Just _ -> -- label is used; generate numerical label - case find (\n -> not (any (== [Str (show n)]) - (map fst refs))) [1..10000] of - Just x -> [Str (show x)] - Nothing -> error "no unique label" - Nothing -> label - modify (\(notes, refs) -> (notes, (label', (src,tit)):refs)) - return label' + (_,refs) <- get + case find ((== (src, tit)) . snd) refs of + Just (ref, _) -> return ref + Nothing -> do + let label' = case find ((== label) . fst) refs of + Just _ -> -- label is used; generate numerical label + case find (\n -> not (any (== [Str (show n)]) + (map fst refs))) [1..10000] of + Just x -> [Str (show x)] + Nothing -> error "no unique label" + Nothing -> label + modify (\(notes, refs) -> (notes, (label', (src,tit)):refs)) + return label' -- | Convert list of Pandoc inline elements to markdown. inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc -inlineListToMarkdown opts lst = mapM (inlineToMarkdown opts) lst >>= (return . hcat) +inlineListToMarkdown opts lst = + mapM (inlineToMarkdown opts) lst >>= return . hcat -- | Convert Pandoc inline element to markdown. inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc @@ -327,13 +322,13 @@ inlineToMarkdown opts (Link txt (src, tit)) = do return $ if useAuto then char '<' <> text srcSuffix <> char '>' else if useRefLinks - then let first = char '[' <> linktext <> char ']' - second = if txt == ref - then text "[]" - else char '[' <> reftext <> char ']' - in first <> second - else char '[' <> linktext <> char ']' <> - char '(' <> text src <> linktitle <> char ')' + then let first = char '[' <> linktext <> char ']' + second = if txt == ref + then text "[]" + else char '[' <> reftext <> char ']' + in first <> second + else char '[' <> linktext <> char ']' <> + char '(' <> text src <> linktitle <> char ')' inlineToMarkdown opts (Image alternate (source, tit)) = do let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index c39f7bdab..70df479b5 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -29,13 +29,11 @@ Conversion of 'Pandoc' documents to reStructuredText. reStructuredText: -} -module Text.Pandoc.Writers.RST ( - writeRST - ) where +module Text.Pandoc.Writers.RST ( writeRST) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Pandoc.Blocks -import Data.List ( group, isPrefixOf, drop, find, intersperse ) +import Data.List ( isPrefixOf, isSuffixOf, drop, intersperse ) import Text.PrettyPrint.HughesPJ hiding ( Str ) import Control.Monad.State @@ -70,8 +68,7 @@ pandocToRST opts (Pandoc meta blocks) = do -- | Return RST representation of reference key table. keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc -keyTableToRST opts refs = - mapM (keyToRST opts) refs >>= (return . vcat) +keyTableToRST opts refs = mapM (keyToRST opts) refs >>= return . vcat -- | Return RST representation of a reference key. keyToRST :: WriterOptions @@ -85,7 +82,7 @@ keyToRST opts (label, (src, tit)) = do notesToRST :: WriterOptions -> [[Block]] -> State WriterState Doc notesToRST opts notes = mapM (\(num, note) -> noteToRST opts num note) (zip [1..] notes) >>= - (return . vcat) + return . vcat -- | Return RST representation of a note. noteToRST :: WriterOptions -> Int -> [Block] -> State WriterState Doc @@ -96,8 +93,7 @@ noteToRST opts num note = do -- | Return RST representation of picture reference table. pictTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc -pictTableToRST opts refs = - mapM (pictToRST opts) refs >>= (return . vcat) +pictTableToRST opts refs = mapM (pictToRST opts) refs >>= return . vcat -- | Return RST representation of a picture substitution reference. pictToRST :: WriterOptions @@ -112,7 +108,7 @@ pictToRST opts (label, (src, _)) = do wrappedRST :: WriterOptions -> [Inline] -> State WriterState Doc wrappedRST opts inlines = mapM (wrappedRSTSection opts) (splitBy LineBreak inlines) >>= - (return . vcat) + return . vcat wrappedRSTSection :: WriterOptions -> [Inline] -> State WriterState Doc wrappedRSTSection opts sect = do @@ -160,21 +156,19 @@ blockToRST :: WriterOptions -- ^ Options blockToRST opts Null = return empty blockToRST opts (Plain inlines) = wrappedRST opts inlines blockToRST opts (Para [TeX str]) = - let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in - return $ hang (text "\n.. raw:: latex\n") 3 - (vcat $ map text (lines str')) + let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in + return $ hang (text "\n.. raw:: latex\n") 3 $ vcat $ map text (lines str') blockToRST opts (Para inlines) = do contents <- wrappedRST opts inlines return $ contents <> text "\n" blockToRST opts (RawHtml str) = - let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in - return $ hang (text "\n.. raw:: html\n") 3 - (vcat $ map text (lines str')) + let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in + return $ hang (text "\n.. raw:: html\n") 3 $ vcat $ map text (lines str') blockToRST opts HorizontalRule = return $ text "--------------\n" blockToRST opts (Header level inlines) = do contents <- inlineListToRST opts inlines let headerLength = length $ render contents - let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) + let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1) let border = text $ replicate headerLength headerChar return $ contents $+$ border <> text "\n" blockToRST opts (CodeBlock str) = return $ (text "::\n") $+$ @@ -200,11 +194,10 @@ blockToRST opts (Table caption aligns widths headers rows) = do beg = TextBlock 2 height (replicate height "| ") end = TextBlock 2 height (replicate height " |") middle = hcatBlocks $ intersperse sep blocks - let makeRow = hpipeBlocks . (zipWith docToBlock widthsInChars) + let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars let head = makeRow headers' - rows' <- mapM (\row -> do - cols <- mapM (blockListToRST opts) row - return $ makeRow cols) rows + rows' <- mapM (\row -> do cols <- mapM (blockListToRST opts) row + return $ makeRow cols) rows let tableWidth = sum widthsInChars let maxRowHeight = maximum $ map heightOfBlock (head:rows') let border ch = char '+' <> char ch <> @@ -225,8 +218,7 @@ blockToRST opts (OrderedList (start, style, delim) items) = do (start, style, delim) let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m - in m ++ replicate s ' ') - markers + in m ++ replicate s ' ') markers contents <- mapM (\(item, num) -> orderedListItemToRST opts item num) $ zip markers' items -- ensure that sublists have preceding blank line @@ -262,11 +254,11 @@ blockListToRST :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements -> State WriterState Doc blockListToRST opts blocks = - mapM (blockToRST opts) blocks >>= (return . vcat) + mapM (blockToRST opts) blocks >>= return . vcat -- | Convert list of Pandoc inline elements to RST. inlineListToRST :: WriterOptions -> [Inline] -> State WriterState Doc -inlineListToRST opts lst = mapM (inlineToRST opts) lst >>= (return . hcat) +inlineListToRST opts lst = mapM (inlineToRST opts) lst >>= return . hcat -- | Convert Pandoc inline element to RST. inlineToRST :: WriterOptions -> Inline -> State WriterState Doc @@ -319,8 +311,8 @@ inlineToRST opts (Link txt (src, tit)) = do inlineToRST opts (Image alternate (source, tit)) = do (notes, refs, pics) <- get let labelsUsed = map fst pics - let txt = if (null alternate) || (alternate == [Str ""]) || - (alternate `elem` labelsUsed) + let txt = if null alternate || alternate == [Str ""] || + alternate `elem` labelsUsed then [Str $ "image" ++ show (length refs)] else alternate let pics' = if (txt, (source, tit)) `elem` pics diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 9b3d6662c..3bd5c63b2 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -27,12 +27,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to RTF (rich text format). -} -module Text.Pandoc.Writers.RTF ( writeRTF) where +module Text.Pandoc.Writers.RTF ( writeRTF ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Regex ( matchRegexAll, mkRegex ) import Data.List ( isSuffixOf ) -import Data.Char ( ord, chr ) +import Data.Char ( ord ) -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String @@ -44,22 +44,22 @@ writeRTF options (Pandoc meta blocks) = then tableOfContents $ filter isHeaderBlock blocks else "" foot = if writerStandalone options then "\n}\n" else "" - body = (writerIncludeBefore options) ++ + body = writerIncludeBefore options ++ concatMap (blockToRTF 0 AlignDefault) blocks ++ - (writerIncludeAfter options) in - head ++ toc ++ body ++ foot + writerIncludeAfter options + in head ++ toc ++ body ++ foot -- | Construct table of contents from list of header blocks. tableOfContents :: [Block] -> String tableOfContents headers = let contentsTree = hierarchicalize headers - in concatMap (blockToRTF 0 AlignDefault) $ [Header 1 [Str "Contents"], - BulletList (map elementToListItem contentsTree)] + in concatMap (blockToRTF 0 AlignDefault) $ + [Header 1 [Str "Contents"], + BulletList (map elementToListItem contentsTree)] elementToListItem :: Element -> [Block] elementToListItem (Blk _) = [] -elementToListItem (Sec sectext subsecs) = - [Plain sectext] ++ +elementToListItem (Sec sectext subsecs) = [Plain sectext] ++ if null subsecs then [] else [BulletList (map elementToListItem subsecs)] @@ -67,10 +67,10 @@ elementToListItem (Sec sectext subsecs) = -- | Convert unicode characters (> 127) into rich text format representation. handleUnicode :: String -> String handleUnicode [] = [] -handleUnicode (c:cs) = if (ord c) > 127 - then '\\':'u':(show (ord c)) ++ "?" ++ - (handleUnicode cs) - else c:(handleUnicode cs) +handleUnicode (c:cs) = + if ord c > 127 + then '\\':'u':(show (ord c)) ++ "?" ++ handleUnicode cs + else c:(handleUnicode cs) -- | Escape special characters. escapeSpecial :: String -> String @@ -127,7 +127,7 @@ listIncrement = 360 -- | Returns appropriate bullet list marker for indent level. bulletMarker :: Int -> String -bulletMarker indent = case (indent `mod` 720) of +bulletMarker indent = case indent `mod` 720 of 0 -> "\\bullet " otherwise -> "\\endash " @@ -135,7 +135,7 @@ bulletMarker indent = case (indent `mod` 720) of orderedMarkers :: Int -> ListAttributes -> [String] orderedMarkers indent (start, style, delim) = if style == DefaultStyle && delim == DefaultDelim - then case (indent `mod` 720) of + then case indent `mod` 720 of 0 -> orderedListMarkers (start, Decimal, Period) otherwise -> orderedListMarkers (start, LowerAlpha, Period) else orderedListMarkers (start, style, delim) @@ -145,21 +145,21 @@ rtfHeader :: String -- ^ header text -> Meta -- ^ bibliographic information -> String rtfHeader headerText (Meta title authors date) = - let titletext = if null title + let titletext = if null title + then "" + else rtfPar 0 0 AlignCenter $ + "\\b \\fs36 " ++ inlineListToRTF title + authorstext = if null authors then "" - else rtfPar 0 0 AlignCenter ("\\b \\fs36 " ++ - inlineListToRTF title) - authorstext = if null authors - then "" - else rtfPar 0 0 AlignCenter (" " ++ (joinWithSep "\\" - (map stringToRTF authors))) - datetext = if date == "" - then "" - else rtfPar 0 0 AlignCenter (" " ++ stringToRTF date) in - let spacer = if null (titletext ++ authorstext ++ datetext) + else rtfPar 0 0 AlignCenter (" " ++ (joinWithSep "\\" $ + map stringToRTF authors)) + datetext = if date == "" then "" - else rtfPar 0 0 AlignDefault "" in - headerText ++ titletext ++ authorstext ++ datetext ++ spacer + else rtfPar 0 0 AlignCenter (" " ++ stringToRTF date) in + let spacer = if null (titletext ++ authorstext ++ datetext) + then "" + else rtfPar 0 0 AlignDefault "" in + headerText ++ titletext ++ authorstext ++ datetext ++ spacer -- | Convert Pandoc block element to RTF. blockToRTF :: Int -- ^ indent level @@ -168,31 +168,27 @@ blockToRTF :: Int -- ^ indent level -> String blockToRTF _ _ Null = "" blockToRTF indent alignment (Plain lst) = - rtfCompact indent 0 alignment (inlineListToRTF lst) + rtfCompact indent 0 alignment $ inlineListToRTF lst blockToRTF indent alignment (Para lst) = - rtfPar indent 0 alignment (inlineListToRTF lst) + rtfPar indent 0 alignment $ inlineListToRTF lst blockToRTF indent alignment (BlockQuote lst) = concatMap (blockToRTF (indent + indentIncrement) alignment) lst blockToRTF indent _ (CodeBlock str) = rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str)) blockToRTF _ _ (RawHtml str) = "" -blockToRTF indent alignment (BulletList lst) = - spaceAtEnd $ +blockToRTF indent alignment (BulletList lst) = spaceAtEnd $ concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst -blockToRTF indent alignment (OrderedList attribs lst) = - spaceAtEnd $ concat $ +blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $ zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst -blockToRTF indent alignment (DefinitionList lst) = - spaceAtEnd $ +blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $ concatMap (definitionListItemToRTF alignment indent) lst blockToRTF indent _ HorizontalRule = rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash" -blockToRTF indent alignment (Header level lst) = - rtfPar indent 0 alignment ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ - (inlineListToRTF lst)) +blockToRTF indent alignment (Header level lst) = rtfPar indent 0 alignment $ + "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst blockToRTF indent alignment (Table caption aligns sizes headers rows) = - (tableRowToRTF True indent aligns sizes headers) ++ (concatMap - (tableRowToRTF False indent aligns sizes) rows) ++ + tableRowToRTF True indent aligns sizes headers ++ + concatMap (tableRowToRTF False indent aligns sizes) rows ++ rtfPar indent 0 alignment (inlineListToRTF caption) tableRowToRTF :: Bool -> Int -> [Alignment] -> [Float] -> [[Block]] -> String @@ -201,8 +197,10 @@ tableRowToRTF header indent aligns sizes cols = totalTwips = 6 * 1440 -- 6 inches rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips)) 0 sizes - cellDefs = map (\edge -> (if header then "\\clbrdrb\\brdrs" - else "") ++ "\\cellx" ++ show edge) rightEdges + cellDefs = map (\edge -> (if header + then "\\clbrdrb\\brdrs" + else "") ++ "\\cellx" ++ show edge) + rightEdges start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++ "\\trkeep\\intbl\n{\n" end = "}\n\\intbl\\row}\n" @@ -234,11 +232,12 @@ listItemToRTF alignment indent marker list = let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list in -- insert the list marker into the (processed) first block let modFirst = case matchRegexAll (mkRegex "\\\\fi-?[0-9]+") first of - Just (before, matched, after, _) -> before ++ "\\fi" ++ - show (0 - listIncrement) ++ " " ++ marker ++ "\\tx" ++ - show listIncrement ++ "\\tab" ++ after + Just (before, matched, after, _) -> + before ++ "\\fi" ++ show (0 - listIncrement) ++ + " " ++ marker ++ "\\tx" ++ + show listIncrement ++ "\\tab" ++ after Nothing -> first in - modFirst ++ (concat rest) + modFirst ++ concat rest -- | Convert definition list item (label, list of blocks) to RTF. definitionListItemToRTF :: Alignment -- ^ alignment @@ -285,4 +284,3 @@ inlineToRTF (Image alternate (source, tit)) = inlineToRTF (Note contents) = "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}" - -- cgit v1.2.3