diff options
author | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-04-10 01:56:50 +0000 |
---|---|---|
committer | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-04-10 01:56:50 +0000 |
commit | 23df0ed1768c4489d41180e145e98a37fd4ac9fc (patch) | |
tree | bb42bf5982f0cdf15d64784897095b2b422a4266 /src/Text/Pandoc/Writers | |
parent | 74e74972260eae3baa69ec254c83c2aaad314e70 (diff) | |
download | pandoc-23df0ed1768c4489d41180e145e98a37fd4ac9fc.tar.gz |
Extensive changes stemming from a rethinking of the Pandoc data
structure. Key and Note blocks have been removed. Link and image URLs
are now stored directly in Link and Image inlines, and note blocks
are stored in Note inlines. This requires changes in both parsers
and writers. Markdown and RST parsers need to extract data from key
and note blocks and insert them into the relevant inline elements.
Other parsers can be simplified, since there is no longer any need to
construct separate key and note blocks. Markdown, RST, and HTML writers
need to construct lists of notes; Markdown and RST writers need to
construct lists of link references (when the --reference-links option
is specified); and the RST writer needs to construct a list of image
substitution references. All writers have been rewritten to use the
State monad when state is required. This rewrite yields a small speed
boost and considerably cleaner code.
* Text/Pandoc/Definition.hs:
+ blocks: removed Key and Note
+ inlines: removed NoteRef, added Note
+ modified Target: there is no longer a 'Ref' target; all targets
are explicit URL, title pairs
* Text/Pandoc/Shared.hs:
+ Added 'Reference', 'isNoteBlock', 'isKeyBlock', 'isLineClump',
used in some of the readers.
+ Removed 'generateReference', 'keyTable', 'replaceReferenceLinks',
'replaceRefLinksBlockList', along with some auxiliary functions
used only by them. These are no longer needed, since
reference links are resolved in the Markdown and RST readers.
+ Moved 'inTags', 'selfClosingTag', 'inTagsSimple', and 'inTagsIndented'
to the Docbook writer, since that is now the only module that uses
them.
+ Changed name of 'escapeSGMLString' to 'escapeStringForXML'
+ Added KeyTable and NoteTable types
+ Removed fields from ParserState; 'stateKeyBlocks', 'stateKeysUsed',
'stateNoteBlocks', 'stateNoteIdentifiers', 'stateInlineLinks'.
Added 'stateKeys' and 'stateNotes'.
+ Added clause for Note to 'prettyBlock'.
+ Added 'writerNotes', 'writerReferenceLinks' fields to WriterOptions.
* Text/Pandoc/Entities.hs: Renamed 'escapeSGMLChar' and
'escapeSGMLString' to 'escapeCharForXML' and 'escapeStringForXML'
* Text/ParserCombinators/Pandoc.hs: Added lineClump parser: parses a raw
line block up to and including following blank lines.
* Main.hs: Replaced --inline-links with --reference-links.
* README:
+ Documented --reference-links and removed description of --inline-links.
+ Added note that footnotes may occur anywhere in the document, but must
be at the outer level, not embedded in block elements.
* man/man1/pandoc.1, man/man1/html2markdown.1: Removed --inline-links
option, added --reference-links option
* Markdown and RST readers:
+ Rewrote to fit new Pandoc definition. Since there are no longer
Note or Key blocks, all note and key blocks are parsed on a first pass
through the document. Once tables of notes and keys have been constructed,
the remaining parts of the document are reassembled and parsed.
+ Refactored link parsers.
* LaTeX and HTML readers: Rewrote to fit new Pandoc definition. Since
there are no longer Note or Key blocks, notes and references can be
parsed in a single pass through the document.
* RST, Markdown, and HTML writers: Rewrote using state monad new Pandoc
and definition. State is used to hold lists of references footnotes to
and be printed at the end of the document.
* RTF and LaTeX writers: Rewrote using new Pandoc definition. (Because
of the different treatment of footnotes, the "notes" parameter is no
longer needed in the block and inline conversion functions.)
* Docbook writer:
+ Moved the functions 'attributeList', 'inTags', 'selfClosingTag',
'inTagsSimple', 'inTagsIndented' from Text/Pandoc/Shared, since
they are now used only by the Docbook writer.
+ Rewrote using new Pandoc definition. (Because of the different
treatment of footnotes, the "notes" parameter is no longer needed
in the block and inline conversion functions.)
* Updated test suite
* Throughout: old haskell98 module names replaced by hierarchical module
names, e.g. List by Data.List.
* debian/control: Include libghc6-xhtml-dev instead of libghc6-html-dev
in "Build-Depends."
* cabalize:
+ Remove haskell98 from BASE_DEPENDS (since now the new hierarchical
module names are being used throughout)
+ Added mtl to BASE_DEPENDS (needed for state monad)
+ Removed html from GHC66_DEPENDS (not needed since xhtml is now used)
git-svn-id: https://pandoc.googlecode.com/svn/trunk@580 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r-- | src/Text/Pandoc/Writers/Docbook.hs | 95 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 289 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 133 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 348 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 425 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 137 |
6 files changed, 764 insertions, 663 deletions
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 87eba9ad0..9fce1c061 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -27,16 +27,53 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion of 'Pandoc' documents to Docbook XML. -} -module Text.Pandoc.Writers.Docbook ( - writeDocbook - ) where +module Text.Pandoc.Writers.Docbook ( writeDocbook) where import Text.Pandoc.Definition import Text.Pandoc.Shared -import Text.Pandoc.Entities ( escapeSGMLString ) +import Text.Pandoc.Entities ( escapeStringForXML ) import Data.Char ( toLower, ord ) import Data.List ( isPrefixOf, partition, drop ) import Text.PrettyPrint.HughesPJ hiding ( Str ) + +-- +-- code to format XML +-- + +-- | Return a text object with a string of formatted XML attributes. +attributeList :: [(String, String)] -> Doc +attributeList = text . concatMap + (\(a, b) -> " " ++ escapeStringForXML a ++ "=\"" ++ + escapeStringForXML b ++ "\"") + +-- | Put the supplied contents between start and end tags of tagType, +-- with specified attributes and (if specified) indentation. +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 + +-- | Return a self-closing tag of tagType with specified attributes +selfClosingTag :: String -> [(String, String)] -> Doc +selfClosingTag tagType attribs = + char '<' <> text tagType <> attributeList attribs <> text " />" + +-- | Put the supplied contents between start and end tags of tagType. +inTagsSimple :: String -> Doc -> Doc +inTagsSimple tagType = inTags False tagType [] + +-- | Put the supplied contents in indented block btw start and end tags. +inTagsIndented :: String -> Doc -> Doc +inTagsIndented tagType = inTags True tagType [] + +-- +-- Docbook writer +-- + -- | Data structure for defining hierarchical Pandoc documents data Element = Blk Block | Sec [Inline] [Element] deriving (Eq, Read, Show) @@ -64,8 +101,8 @@ authorToDocbook name = inTagsIndented "author" $ then -- last name first let (lastname, rest) = break (==',') name firstname = removeLeadingSpace rest in - inTagsSimple "firstname" (text $ escapeSGMLString firstname) <> - inTagsSimple "surname" (text $ escapeSGMLString lastname) + inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> + inTagsSimple "surname" (text $ escapeStringForXML lastname) else -- last name last let namewords = words name lengthname = length namewords @@ -73,8 +110,8 @@ authorToDocbook name = inTagsIndented "author" $ 0 -> ("","") 1 -> ("", name) n -> (joinWithSep " " (take (n-1) namewords), last namewords) in - inTagsSimple "firstname" (text $ escapeSGMLString firstname) $$ - inTagsSimple "surname" (text $ escapeSGMLString lastname) + inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ + inTagsSimple "surname" (text $ escapeStringForXML lastname) -- | Convert Pandoc document to string in Docbook format. writeDocbook :: WriterOptions -> Pandoc -> String @@ -86,18 +123,15 @@ writeDocbook opts (Pandoc (Meta title authors date) blocks) = then inTagsIndented "articleinfo" $ (inTagsSimple "title" (wrap opts title)) $$ (vcat (map authorToDocbook authors)) $$ - (inTagsSimple "date" (text $ escapeSGMLString date)) + (inTagsSimple "date" (text $ escapeStringForXML date)) else empty - blocks' = replaceReferenceLinks blocks - (noteBlocks, blocks'') = partition isNoteBlock blocks' - opts' = opts {writerNotes = noteBlocks} - elements = hierarchicalize blocks'' - before = writerIncludeBefore opts' - after = writerIncludeAfter opts' + elements = hierarchicalize blocks + before = writerIncludeBefore opts + after = writerIncludeAfter opts body = (if null before then empty else text before) $$ - vcat (map (elementToDocbook opts') elements) $$ + vcat (map (elementToDocbook opts) elements) $$ (if null after then empty else text after) - body' = if writerStandalone opts' + body' = if writerStandalone opts then inTagsIndented "article" (meta $$ body) else body in render $ head $$ body' $$ text "" @@ -140,15 +174,13 @@ blockToDocbook opts (Para lst) = blockToDocbook opts (BlockQuote blocks) = inTagsIndented "blockquote" (blocksToDocbook opts blocks) blockToDocbook opts (CodeBlock str) = - text "<screen>\n" <> text (escapeSGMLString str) <> text "\n</screen>" + text "<screen>\n" <> text (escapeStringForXML str) <> text "\n</screen>" blockToDocbook opts (BulletList lst) = inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst blockToDocbook opts (OrderedList lst) = inTagsIndented "orderedlist" $ listItemsToDocbook opts lst blockToDocbook opts (RawHtml str) = text str -- raw XML block blockToDocbook opts HorizontalRule = empty -- not semantic -blockToDocbook opts (Note _ _) = empty -- shouldn't occur -blockToDocbook opts (Key _ _) = empty -- shouldn't occur blockToDocbook opts (Table caption aligns widths headers rows) = let alignStrings = map alignmentToString aligns captionDoc = if null caption @@ -197,7 +229,7 @@ inlinesToDocbook opts lst = hcat (map (inlineToDocbook opts) lst) -- | Convert an inline element to Docbook. inlineToDocbook :: WriterOptions -> Inline -> Doc -inlineToDocbook opts (Str str) = text $ escapeSGMLString str +inlineToDocbook opts (Str str) = text $ escapeStringForXML str inlineToDocbook opts (Emph lst) = inTagsSimple "emphasis" (inlinesToDocbook opts lst) inlineToDocbook opts (Strong lst) = @@ -210,31 +242,24 @@ inlineToDocbook opts Ellipses = text "…" inlineToDocbook opts EmDash = text "—" inlineToDocbook opts EnDash = text "–" inlineToDocbook opts (Code str) = - inTagsSimple "literal" $ text (escapeSGMLString str) + inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (TeX str) = inlineToDocbook opts (Code str) inlineToDocbook opts (HtmlInline str) = empty inlineToDocbook opts LineBreak = text $ "<literallayout></literallayout>" inlineToDocbook opts Space = char ' ' -inlineToDocbook opts (Link txt (Src src tit)) = +inlineToDocbook opts (Link txt (src, tit)) = if isPrefixOf "mailto:" src - then inTagsSimple "email" $ text (escapeSGMLString $ drop 7 src) + then inTagsSimple "email" $ text (escapeStringForXML $ drop 7 src) else inTags False "ulink" [("url", src)] $ inlinesToDocbook opts txt -inlineToDocbook opts (Link text (Ref ref)) = empty -- shouldn't occur -inlineToDocbook opts (Image alt (Src src tit)) = +inlineToDocbook opts (Image alt (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ inTagsIndented "title" - (text $ escapeSGMLString tit) in + (text $ escapeStringForXML tit) in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] -inlineToDocbook opts (Image alternate (Ref ref)) = empty --shouldn't occur -inlineToDocbook opts (NoteRef ref) = - let notes = writerNotes opts - hits = filter (\(Note r _) -> r == ref) notes in - if null hits - then empty - else let (Note _ contents) = head hits in - inTagsIndented "footnote" $ blocksToDocbook opts contents +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 be5eb8506..f6fc0741e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -35,8 +35,11 @@ import Text.Regex ( mkRegex, matchRegex ) import Numeric ( showHex ) import Data.Char ( ord, toLower ) import Data.List ( isPrefixOf, partition ) +import Control.Monad.State import Text.XHtml.Strict +type Notes = [Html] + -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts = @@ -48,13 +51,10 @@ writeHtmlString opts = writeHtml :: WriterOptions -> Pandoc -> Html writeHtml opts (Pandoc (Meta tit authors date) blocks) = let titlePrefix = writerTitlePrefix opts - topTitle = inlineListToHtml opts tit - topTitle' = if not (null titlePrefix) - then stringToHtml titlePrefix +++ - if not (null tit) - then '-' +++ topTitle - else noHtml - else topTitle + topTitle = evalState (inlineListToHtml opts tit) [] + topTitle' = if null titlePrefix + then topTitle + else titlePrefix +++ " - " +++ topTitle head = header $ thetitle topTitle' +++ meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"] +++ @@ -69,31 +69,30 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) = (not (writerS5 opts)) then h1 ! [theclass "title"] $ topTitle else noHtml - blocks' = replaceReferenceLinks blocks - (noteBlocks, blocks'') = partition isNoteBlock blocks' + (blocks', revnotes) = runState (blockListToHtml opts blocks) [] + notes = reverse revnotes before = primHtml $ writerIncludeBefore opts after = primHtml $ writerIncludeAfter opts - thebody = before +++ titleHeader +++ - toHtmlFromList (map (blockToHtml opts) blocks'') +++ - footnoteSection opts noteBlocks +++ after + thebody = before +++ titleHeader +++ blocks' +++ + footnoteSection opts notes +++ after in if writerStandalone opts then head +++ (body thebody) else thebody -- | Convert list of Note blocks to a footnote <div>. -- Assumes notes are sorted. -footnoteSection :: WriterOptions -> [Block] -> Html +footnoteSection :: WriterOptions -> Notes -> Html footnoteSection opts notes = if null notes - then noHtml - else thediv ! [theclass "footnotes"] $ - hr +++ (olist $ toHtmlFromList $ map (blockToHtml opts) notes) + then noHtml + else thediv ! [theclass "footnotes"] $ + hr +++ (olist << notes) -- | Obfuscate a "mailto:" link using Javascript. -obfuscateLink :: WriterOptions -> [Inline] -> String -> Html -obfuscateLink opts txt src = +obfuscateLink :: WriterOptions -> Html -> String -> Html +obfuscateLink opts text src = let emailRegex = mkRegex "mailto:*([^@]*)@(.*)" - text' = show $ inlineListToHtml opts txt + text' = show $ text src' = map toLower src in case (matchRegex emailRegex src') of (Just [name, domain]) -> @@ -117,7 +116,7 @@ obfuscateLink opts txt src = "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++ noscript (primHtml $ obfuscateString altText) - _ -> anchor ! [href src] $ inlineListToHtml opts txt -- malformed email + _ -> anchor ! [href src] $ text -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String @@ -131,137 +130,153 @@ obfuscateString :: String -> String obfuscateString = (concatMap obfuscateChar) . decodeEntities -- | Convert Pandoc block element to HTML. -blockToHtml :: WriterOptions -> Block -> Html -blockToHtml opts Null = noHtml -blockToHtml opts (Plain lst) = inlineListToHtml opts lst -blockToHtml opts (Para lst) = paragraph $ inlineListToHtml opts lst -blockToHtml opts (BlockQuote blocks) = - if (writerS5 opts) - then -- in S5, treat list in blockquote specially - -- if default is incremental, make it nonincremental; - -- otherwise incremental - let inc = not (writerIncremental opts) in - case blocks of - [BulletList lst] -> blockToHtml (opts {writerIncremental = - inc}) (BulletList lst) - [OrderedList lst] -> blockToHtml (opts {writerIncremental = - inc}) (OrderedList lst) - otherwise -> blockquote $ toHtmlFromList $ - map (blockToHtml opts) blocks - else blockquote $ toHtmlFromList $ map (blockToHtml opts) blocks -blockToHtml opts (Note ref lst) = - let contents = toHtmlFromList $ map (blockToHtml opts) lst - backlink = anchor ! [href ("#fnref" ++ ref), theclass "footnoteBacklink", - title ("Jump back to footnote " ++ ref)] $ - (primHtmlChar "#8617") in - li ! [identifier ("fn" ++ ref)] $ contents +++ backlink -blockToHtml opts (Key _ _) = noHtml -blockToHtml opts (CodeBlock str) = - pre $ thecode << (str ++ "\n") -- the final \n for consistency with Markdown.pl -blockToHtml opts (RawHtml str) = primHtml str -blockToHtml opts (BulletList lst) = - let attribs = if writerIncremental opts - then [theclass "incremental"] - else [] in - unordList ! attribs $ map (blockListToHtml opts) lst -blockToHtml opts (OrderedList lst) = - let attribs = if writerIncremental opts - then [theclass "incremental"] - else [] in - ordList ! attribs $ map (blockListToHtml opts) lst -blockToHtml opts (DefinitionList lst) = - let attribs = if writerIncremental opts - then [theclass "incremental"] - else [] in - defList ! attribs $ map (\(term, def) -> (inlineListToHtml opts term, - blockListToHtml opts def)) lst -blockToHtml opts HorizontalRule = hr -blockToHtml opts (Header level lst) = - let contents = inlineListToHtml opts lst in - case level of - 1 -> h1 contents - 2 -> h2 contents - 3 -> h3 contents - 4 -> h4 contents - 5 -> h5 contents - 6 -> h6 contents - _ -> paragraph contents -blockToHtml opts (Table capt aligns widths headers rows) = - let alignStrings = map alignmentToString aligns - captionDoc = if null capt - then noHtml - else caption $ inlineListToHtml opts capt in - table $ captionDoc +++ - (colHeadsToHtml opts alignStrings widths headers) +++ - (toHtmlFromList $ map (tableRowToHtml opts alignStrings) rows) +blockToHtml :: WriterOptions -> Block -> State Notes 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") + -- 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 lst] -> blockToHtml (opts {writerIncremental = inc}) + (OrderedList lst) + otherwise -> blockListToHtml opts blocks >>= + (return . blockquote) + else blockListToHtml opts blocks >>= (return . blockquote) + (Header level lst) -> do contents <- inlineListToHtml opts lst + return $ case level of + 1 -> h1 contents + 2 -> h2 contents + 3 -> h3 contents + 4 -> h4 contents + 5 -> h5 contents + 6 -> h6 contents + _ -> paragraph contents + (BulletList lst) -> do contents <- mapM (blockListToHtml opts) lst + let attribs = if writerIncremental opts + then [theclass "incremental"] + else [] + return $ unordList ! attribs $ contents + (OrderedList lst) -> do contents <- mapM (blockListToHtml opts) lst + let attribs = if writerIncremental opts + then [theclass "incremental"] + else [] + 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' colHeadsToHtml opts alignStrings widths headers = - let heads = zipWith3 - (\align width item -> tableItemToHtml opts th align width item) - alignStrings widths headers in - tr $ toHtmlFromList heads + 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" AlignRight -> "right" AlignCenter -> "center" AlignDefault -> "left" + tableRowToHtml opts aligns cols = - tr $ toHtmlFromList $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols + do contents <- sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols + return $ tr $ toHtmlFromList contents tableItemToHtml opts tag align' width item = - let attrib = [align align'] ++ - if (width /= 0) - then [thestyle ("{width: " ++ show (truncate (100*width)) ++ "%;}")] - else [] in - tag ! attrib $ toHtmlFromList $ map (blockToHtml opts) 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] -> Html -blockListToHtml opts list = - toHtmlFromList $ map (blockToHtml opts) list +blockListToHtml :: WriterOptions -> [Block] -> State Notes Html +blockListToHtml opts lst = mapM (blockToHtml opts) lst >>= (return . toHtmlFromList) -- | Convert list of Pandoc inline elements to HTML. -inlineListToHtml :: WriterOptions -> [Inline] -> Html -inlineListToHtml opts lst = toHtmlFromList $ map (inlineToHtml opts) lst +inlineListToHtml :: WriterOptions -> [Inline] -> State Notes Html +inlineListToHtml opts lst = mapM (inlineToHtml opts) lst >>= (return . toHtmlFromList) -- | Convert Pandoc inline element to HTML. -inlineToHtml :: WriterOptions -> Inline -> Html -inlineToHtml opts (Emph lst) = - emphasize $ inlineListToHtml opts lst -inlineToHtml opts (Strong lst) = - strong $ inlineListToHtml opts lst -inlineToHtml opts (Code str) = - thecode << str -inlineToHtml opts (Quoted SingleQuote lst) = - primHtmlChar "lsquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rsquo" -inlineToHtml opts (Quoted DoubleQuote lst) = - primHtmlChar "ldquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rdquo" -inlineToHtml opts EmDash = primHtmlChar "mdash" -inlineToHtml opts EnDash = primHtmlChar "ndash" -inlineToHtml opts Ellipses = primHtmlChar "hellip" -inlineToHtml opts Apostrophe = primHtmlChar "rsquo" -inlineToHtml opts (Str str) = stringToHtml str -inlineToHtml opts (TeX str) = stringToHtml str -inlineToHtml opts (HtmlInline str) = primHtml str -inlineToHtml opts (LineBreak) = br -inlineToHtml opts Space = stringToHtml " " -inlineToHtml opts (Link txt (Src src tit)) = - if (isPrefixOf "mailto:" src) - then obfuscateLink opts txt src - else anchor ! ([href src] ++ if null tit then [] else [title tit]) $ - inlineListToHtml opts txt -inlineToHtml opts (Link txt (Ref ref)) = - '[' +++ (inlineListToHtml opts txt) +++ - ']' +++ '[' +++ (inlineListToHtml opts ref) +++ - ']' - -- this is what markdown does, for better or worse -inlineToHtml opts (Image alttext (Src source tit)) = - let alternate = renderHtmlFragment $ inlineListToHtml opts alttext in - image ! ([src source, title tit] ++ if null alttext then [] else [alt alternate]) - -- note: null title is included, as in Markdown.pl -inlineToHtml opts (Image alternate (Ref ref)) = - '!' +++ inlineToHtml opts (Link alternate (Ref ref)) -inlineToHtml opts (NoteRef ref) = - anchor ! [href ("#fn" ++ ref), theclass "footnoteRef", identifier ("fnref" ++ ref)] << - sup << ref +inlineToHtml :: WriterOptions -> Inline -> State Notes Html +inlineToHtml opts inline = + case inline of + (Str str) -> return $ stringToHtml str + (Space) -> return $ stringToHtml " " + (LineBreak) -> return $ br + (EmDash) -> return $ primHtmlChar "mdash" + (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) + (Code str) -> return $ thecode << str + (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) -> return $ stringToHtml str + (HtmlInline str) -> return $ primHtml str + (Link txt (src,tit)) -> + do linkText <- inlineListToHtml opts txt + return $ if (isPrefixOf "mailto:" src) + then obfuscateLink opts linkText src + else 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 notes <- get + let number = (length notes) + 1 + let ref = show number + htmlContents <- blockListToNote opts ref contents + modify (htmlContents:) -- push contents onto front of notes + return $ anchor ! [href ("#fn" ++ ref), + theclass "footnoteRef", + identifier ("fnref" ++ ref)] << sup << ref + +blockListToNote :: WriterOptions -> String -> [Block] -> State Notes Html +blockListToNote opts ref blocks = + do contents <- blockListToHtml opts blocks + let backlink = anchor ! [href ("#fnref" ++ ref), theclass "footnoteBacklink", + title ("Jump back to footnote " ++ ref)] $ + (primHtmlChar "#8617") + return $ li ! [identifier ("fn" ++ ref)] $ contents +++ backlink diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index de1b7e207..8a9cacba3 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -33,31 +33,28 @@ module Text.Pandoc.Writers.LaTeX ( import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) -import List ( (\\) ) +import Data.List ( (\\) ) -- | Convert Pandoc to LaTeX. writeLaTeX :: WriterOptions -> Pandoc -> String writeLaTeX options (Pandoc meta blocks) = - let notes = filter isNoteBlock blocks in -- assumes all notes at outer level let body = (writerIncludeBefore options) ++ - (concatMap (blockToLaTeX notes) - (replaceReferenceLinks blocks)) ++ + (concatMap blockToLaTeX blocks) ++ (writerIncludeAfter options) in let head = if writerStandalone options - then latexHeader notes options meta + then latexHeader options meta else "" in let foot = if writerStandalone options then "\n\\end{document}\n" else "" in head ++ body ++ foot -- | Insert bibliographic information into LaTeX header. -latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs - -> WriterOptions -- ^ Options, including LaTeX header +latexHeader :: WriterOptions -- ^ Options, including LaTeX header -> Meta -- ^ Meta with bibliographic information -> String -latexHeader notes options (Meta title authors date) = +latexHeader options (Meta title authors date) = let titletext = if null title then "" - else "\\title{" ++ inlineListToLaTeX notes title ++ "}\n" + else "\\title{" ++ inlineListToLaTeX title ++ "}\n" authorstext = if null authors then "" else "\\author{" ++ (joinWithSep "\\\\" @@ -99,31 +96,28 @@ deVerb ((Code str):rest) = (Str str):(deVerb rest) deVerb (other:rest) = other:(deVerb rest) -- | Convert Pandoc block element to LaTeX. -blockToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs - -> Block -- ^ Block to convert +blockToLaTeX :: Block -- ^ Block to convert -> String -blockToLaTeX notes Null = "" -blockToLaTeX notes (Plain lst) = inlineListToLaTeX notes lst ++ "\n" -blockToLaTeX notes (Para lst) = (inlineListToLaTeX notes lst) ++ "\n\n" -blockToLaTeX notes (BlockQuote lst) = "\\begin{quote}\n" ++ - (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n" -blockToLaTeX notes (Note ref lst) = "" -blockToLaTeX notes (Key _ _) = "" -blockToLaTeX notes (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++ +blockToLaTeX Null = "" +blockToLaTeX (Plain lst) = inlineListToLaTeX lst ++ "\n" +blockToLaTeX (Para lst) = (inlineListToLaTeX lst) ++ "\n\n" +blockToLaTeX (BlockQuote lst) = "\\begin{quote}\n" ++ + (concatMap blockToLaTeX lst) ++ "\\end{quote}\n" +blockToLaTeX (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++ "\n\\end{verbatim}\n" -blockToLaTeX notes (RawHtml str) = "" -blockToLaTeX notes (BulletList lst) = "\\begin{itemize}\n" ++ - (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n" -blockToLaTeX notes (OrderedList lst) = "\\begin{enumerate}\n" ++ - (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n" -blockToLaTeX notes HorizontalRule = +blockToLaTeX (RawHtml str) = "" +blockToLaTeX (BulletList lst) = "\\begin{itemize}\n" ++ + (concatMap listItemToLaTeX lst) ++ "\\end{itemize}\n" +blockToLaTeX (OrderedList lst) = "\\begin{enumerate}\n" ++ + (concatMap listItemToLaTeX lst) ++ "\\end{enumerate}\n" +blockToLaTeX HorizontalRule = "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n" -blockToLaTeX notes (Header level lst) = +blockToLaTeX (Header level lst) = if (level > 0) && (level <= 3) then "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++ - (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n" - else (inlineListToLaTeX notes lst) ++ "\n\n" -blockToLaTeX notes (Table caption aligns widths heads rows) = + (inlineListToLaTeX (deVerb lst)) ++ "}\n\n" + else (inlineListToLaTeX lst) ++ "\n\n" +blockToLaTeX (Table caption aligns widths heads rows) = let colWidths = map printDecimal widths colDescriptors = concat $ zipWith (\width align -> ">{\\PBS" ++ @@ -135,11 +129,11 @@ blockToLaTeX notes (Table caption aligns widths heads rows) = "\\hspace{0pt}}p{" ++ width ++ "\\textwidth}") colWidths aligns - headers = tableRowToLaTeX notes heads - captionText = inlineListToLaTeX notes caption + headers = tableRowToLaTeX heads + captionText = inlineListToLaTeX caption tableBody = "\\begin{tabular}{" ++ colDescriptors ++ "}\n" ++ headers ++ "\\hline\n" ++ - (concatMap (tableRowToLaTeX notes) rows) ++ + (concatMap tableRowToLaTeX rows) ++ "\\end{tabular}\n" centered str = "\\begin{center}\n" ++ str ++ "\\end{center}\n" in if null captionText @@ -151,19 +145,18 @@ blockToLaTeX notes (Table caption aligns widths heads rows) = printDecimal :: Float -> String printDecimal = printf "%.2f" -tableColumnWidths notes cols = map (length . (concatMap (blockToLaTeX notes))) cols +tableColumnWidths cols = map (length . (concatMap blockToLaTeX)) cols -tableRowToLaTeX notes cols = joinWithSep " & " (map (concatMap (blockToLaTeX notes)) cols) ++ "\\\\\n" +tableRowToLaTeX cols = joinWithSep " & " (map (concatMap blockToLaTeX) cols) ++ "\\\\\n" -listItemToLaTeX notes list = "\\item " ++ - (concatMap (blockToLaTeX notes) list) +listItemToLaTeX list = "\\item " ++ + (concatMap blockToLaTeX list) -- | Convert list of inline elements to LaTeX. -inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs - -> [Inline] -- ^ Inlines to convert +inlineListToLaTeX :: [Inline] -- ^ Inlines to convert -> String -inlineListToLaTeX notes lst = - concatMap (inlineToLaTeX notes) lst +inlineListToLaTeX lst = + concatMap inlineToLaTeX lst isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True @@ -171,47 +164,35 @@ isQuoted Apostrophe = True isQuoted _ = False -- | Convert inline element to LaTeX -inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs - -> Inline -- ^ Inline to convert +inlineToLaTeX :: Inline -- ^ Inline to convert -> String -inlineToLaTeX notes (Emph lst) = "\\emph{" ++ - (inlineListToLaTeX notes (deVerb lst)) ++ "}" -inlineToLaTeX notes (Strong lst) = "\\textbf{" ++ - (inlineListToLaTeX notes (deVerb lst)) ++ "}" -inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr] +inlineToLaTeX (Emph lst) = "\\emph{" ++ + (inlineListToLaTeX (deVerb lst)) ++ "}" +inlineToLaTeX (Strong lst) = "\\textbf{" ++ + (inlineListToLaTeX (deVerb lst)) ++ "}" +inlineToLaTeX (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr] where stuffing = str chr = ((enumFromTo '!' '~') \\ stuffing) !! 0 -inlineToLaTeX notes (Quoted SingleQuote lst) = +inlineToLaTeX (Quoted SingleQuote lst) = let s1 = if (not (null lst)) && (isQuoted (head lst)) then "\\," else "" s2 = if (not (null lst)) && (isQuoted (last lst)) then "\\," else "" in - "`" ++ s1 ++ inlineListToLaTeX notes lst ++ s2 ++ "'" -inlineToLaTeX notes (Quoted DoubleQuote lst) = + "`" ++ s1 ++ inlineListToLaTeX lst ++ s2 ++ "'" +inlineToLaTeX (Quoted DoubleQuote lst) = let s1 = if (not (null lst)) && (isQuoted (head lst)) then "\\," else "" s2 = if (not (null lst)) && (isQuoted (last lst)) then "\\," else "" in - "``" ++ s1 ++ inlineListToLaTeX notes lst ++ s2 ++ "''" -inlineToLaTeX notes Apostrophe = "'" -inlineToLaTeX notes EmDash = "---" -inlineToLaTeX notes EnDash = "--" -inlineToLaTeX notes Ellipses = "\\ldots{}" -inlineToLaTeX notes (Str str) = stringToLaTeX str -inlineToLaTeX notes (TeX str) = str -inlineToLaTeX notes (HtmlInline str) = "" -inlineToLaTeX notes (LineBreak) = "\\\\\n" -inlineToLaTeX notes Space = " " -inlineToLaTeX notes (Link text (Src src tit)) = - "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX notes (deVerb text)) ++ "}" -inlineToLaTeX notes (Link text (Ref ref)) = "[" ++ - (inlineListToLaTeX notes text) ++ "][" ++ (inlineListToLaTeX notes ref) ++ - "]" -- this is what markdown does, for better or worse -inlineToLaTeX notes (Image alternate (Src source tit)) = + "``" ++ s1 ++ inlineListToLaTeX lst ++ s2 ++ "''" +inlineToLaTeX Apostrophe = "'" +inlineToLaTeX EmDash = "---" +inlineToLaTeX EnDash = "--" +inlineToLaTeX Ellipses = "\\ldots{}" +inlineToLaTeX (Str str) = stringToLaTeX str +inlineToLaTeX (TeX str) = str +inlineToLaTeX (HtmlInline str) = "" +inlineToLaTeX (LineBreak) = "\\\\\n" +inlineToLaTeX Space = " " +inlineToLaTeX (Link text (src, tit)) = + "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX (deVerb text)) ++ "}" +inlineToLaTeX (Image alternate (source, tit)) = "\\includegraphics{" ++ source ++ "}" -inlineToLaTeX notes (Image alternate (Ref ref)) = - "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++ - (inlineListToLaTeX notes ref) ++ "]" -inlineToLaTeX [] (NoteRef ref) = "" -inlineToLaTeX ((Note firstref firstblocks):rest) (NoteRef ref) = - if (firstref == ref) - then "\\footnote{" ++ (stripTrailingNewlines - (concatMap (blockToLaTeX rest) firstblocks)) ++ "}" - else inlineToLaTeX rest (NoteRef ref) - +inlineToLaTeX (Note contents) = + "\\footnote{" ++ (stripTrailingNewlines $ concatMap blockToLaTeX contents) ++ "}" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 687f6e6c4..8f1b3cea9 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -34,19 +34,71 @@ module Text.Pandoc.Writers.Markdown ( ) where import Text.Pandoc.Definition import Text.Pandoc.Shared -import Data.List ( group, isPrefixOf, drop ) +import Data.List ( group, isPrefixOf, drop, find ) import Text.PrettyPrint.HughesPJ hiding ( Str ) +import Control.Monad.State + +type Notes = [[Block]] +type Refs = KeyTable +type WriterState = (Notes, Refs) -- | Convert Pandoc to Markdown. writeMarkdown :: WriterOptions -> Pandoc -> String -writeMarkdown options (Pandoc meta blocks) = - let body = text (writerIncludeBefore options) <> - vcat (map (blockToMarkdown (writerTabStop options)) - (formatKeys blocks)) $$ text (writerIncludeAfter options) in - let head = if (writerStandalone options) - then ((metaToMarkdown meta) $$ text (writerHeader options)) - else empty in - render $ head <> body +writeMarkdown opts document = + render $ evalState (pandocToMarkdown opts document) ([],[]) + +-- | Return markdown representation of document. +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 + metaBlock <- metaToMarkdown opts meta + let head = if (writerStandalone opts) + then metaBlock $$ text (writerHeader opts) + else empty + body <- blockListToMarkdown opts blocks + (notes, _) <- get + notes' <- notesToMarkdown opts (reverse notes) + (_, refs) <- get -- note that the notes may contain refs + refs' <- keyTableToMarkdown opts (reverse refs) + return $ head <> (before' $$ body <> text "\n" $$ + notes' <> text "\n" $$ refs' $$ after') + +-- | Return markdown representation of reference key table. +keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc +keyTableToMarkdown opts refs = + mapM (keyToMarkdown opts) refs >>= (return . vcat) + +-- | Return markdown representation of a reference key. +keyToMarkdown :: WriterOptions + -> ([Inline], (String, String)) + -> State WriterState Doc +keyToMarkdown opts (label, (src, tit)) = do + label' <- inlineListToMarkdown opts label + let tit' = if null tit then empty else text $ " \"" ++ tit ++ "\"" + return $ text " " <> char '[' <> label' <> char ']' <> text ": " <> + text src <> tit' + +-- | Return markdown representation of notes. +notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc +notesToMarkdown opts notes = + mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>= + (return . vcat) + +-- | Return markdown representation of a note. +noteToMarkdown :: WriterOptions -> Int -> [Block] -> State WriterState Doc +noteToMarkdown opts num note = do + contents <- blockListToMarkdown opts note + let marker = text "[^" <> text (show num) <> text "]:" + return $ hang marker (writerTabStop opts) contents + +wrappedMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc +wrappedMarkdown opts sect = do + let chunks = splitBy Space sect + chunks' <- mapM (inlineListToMarkdown opts) chunks + return $ fsep chunks' -- | Escape nonbreaking space as entity escapeNbsp "" = "" @@ -59,155 +111,163 @@ escapeNbsp str = escapeString :: String -> String escapeString = backslashEscape "`<\\*_^" . escapeNbsp --- | Take list of inline elements and return wrapped doc. -wrappedMarkdown :: [Inline] -> Doc -wrappedMarkdown lst = - let wrapSection sec = fsep $ map inlineListToMarkdown $ (splitBy Space sec) - wrappedSecs = map wrapSection $ splitBy LineBreak lst - wrappedSecs' = foldr (\s rest -> if not (null rest) - then (s <> text " "):rest - else s:rest) [] wrappedSecs in - vcat wrappedSecs' - --- | Insert Blank block between key and non-key -formatKeys :: [Block] -> [Block] -formatKeys [] = [] -formatKeys [x] = [x] -formatKeys ((Key x1 y1):(Key x2 y2):rest) = - (Key x1 y1):(formatKeys ((Key x2 y2):rest)) -formatKeys ((Key x1 y1):rest) = (Key x1 y1):(Plain [Str ""]):(formatKeys rest) -formatKeys (x:(Key x1 y1):rest) = x:(Plain [Str ""]):(formatKeys ((Key x1 y1):rest)) -formatKeys (x:rest) = x:(formatKeys rest) - -- | Convert bibliographic information into Markdown header. -metaToMarkdown :: Meta -> Doc -metaToMarkdown (Meta [] [] "") = empty -metaToMarkdown (Meta title [] "") = (titleToMarkdown title) <> (text "\n") -metaToMarkdown (Meta title authors "") = (titleToMarkdown title) <> - (text "\n") <> (authorsToMarkdown authors) <> (text "\n") -metaToMarkdown (Meta title authors date) = (titleToMarkdown title) <> - (text "\n") <> (authorsToMarkdown authors) <> (text "\n") <> - (dateToMarkdown date) <> (text "\n") +metaToMarkdown :: WriterOptions -> Meta -> State WriterState Doc +metaToMarkdown opts (Meta title authors date) = do + title' <- titleToMarkdown opts title + authors' <- authorsToMarkdown authors + date' <- dateToMarkdown date + return $ title' <> authors' <> date' -titleToMarkdown :: [Inline] -> Doc -titleToMarkdown lst = text "% " <> (inlineListToMarkdown lst) +titleToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc +titleToMarkdown opts [] = return empty +titleToMarkdown opts lst = do + contents <- inlineListToMarkdown opts lst + return $ text "% " <> contents <> text "\n" -authorsToMarkdown :: [String] -> Doc -authorsToMarkdown lst = - text "% " <> text (joinWithSep ", " (map escapeString lst)) +authorsToMarkdown :: [String] -> State WriterState Doc +authorsToMarkdown [] = return empty +authorsToMarkdown lst = return $ + text "% " <> text (joinWithSep ", " (map escapeString lst)) <> text "\n" -dateToMarkdown :: String -> Doc -dateToMarkdown str = text "% " <> text (escapeString str) +dateToMarkdown :: String -> State WriterState Doc +dateToMarkdown [] = return empty +dateToMarkdown str = return $ text "% " <> text (escapeString str) <> text "\n" -- | Convert Pandoc block element to markdown. -blockToMarkdown :: Int -- ^ Tab stop - -> Block -- ^ Block element - -> Doc -blockToMarkdown tabStop Null = empty -blockToMarkdown tabStop (Plain lst) = wrappedMarkdown lst -blockToMarkdown tabStop (Para lst) = (wrappedMarkdown lst) <> (text "\n") -blockToMarkdown tabStop (BlockQuote lst) = - (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $ - map (blockToMarkdown tabStop) lst) <> (text "\n") -blockToMarkdown tabStop (Note ref lst) = - let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in - if null lns - then empty - else let first = head lns - rest = tail lns in - text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$ - (vcat $ map (\line -> (text " ") <> (text line)) rest) <> - text "\n" -blockToMarkdown tabStop (Key txt (Src src tit)) = - text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <> - text ": " <> text src <> - if tit /= "" then text (" \"" ++ tit ++ "\"") else empty -blockToMarkdown tabStop (CodeBlock str) = - (nest tabStop $ vcat $ map text (lines str)) <> text "\n" -blockToMarkdown tabStop (RawHtml str) = text str -blockToMarkdown tabStop (BulletList lst) = - vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n" -blockToMarkdown tabStop (OrderedList lst) = - vcat (zipWith (orderedListItemToMarkdown tabStop) - (enumFromTo 1 (length lst)) lst) <> text "\n" -blockToMarkdown tabStop HorizontalRule = text "\n* * * * *\n" -blockToMarkdown tabStop (Header level lst) = text ((replicate level '#') ++ - " ") <> (inlineListToMarkdown lst) <> (text "\n") -blockToMarkdown tabStop (Table caption _ _ headers rows) = - blockToMarkdown tabStop (Para [Str "pandoc: TABLE unsupported in Markdown writer"]) - - -bulletListItemToMarkdown tabStop list = - hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list)) +blockToMarkdown :: WriterOptions -- ^ Options + -> Block -- ^ Block element + -> State WriterState Doc +blockToMarkdown opts Null = return empty +blockToMarkdown opts (Plain inlines) = wrappedMarkdown opts inlines +blockToMarkdown opts (Para inlines) = do + contents <- wrappedMarkdown opts inlines + return $ contents <> text "\n" +blockToMarkdown opts (RawHtml str) = return $ text str +blockToMarkdown opts HorizontalRule = return $ text "\n* * * * *\n" +blockToMarkdown opts (Header level inlines) = do + contents <- inlineListToMarkdown opts inlines + return $ text ((replicate level '#') ++ " ") <> contents <> text "\n" +blockToMarkdown opts (CodeBlock str) = return $ + (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n" +blockToMarkdown opts (BlockQuote blocks) = do + contents <- blockListToMarkdown opts blocks + let quotedContents = unlines $ map ("> " ++) $ lines $ render contents + return $ text quotedContents +blockToMarkdown opts (Table caption _ _ headers rows) = blockToMarkdown opts + (Para [Str "pandoc: TABLE unsupported in Markdown writer"]) +blockToMarkdown opts (BulletList items) = do + contents <- mapM (bulletListItemToMarkdown opts) items + return $ (vcat contents) <> text "\n" +blockToMarkdown opts (OrderedList items) = do + contents <- mapM (\(item, num) -> orderedListItemToMarkdown opts item num) $ + zip [1..] items + return $ (vcat contents) <> text "\n" + +-- | Convert bullet list item (list of blocks) to markdown. +bulletListItemToMarkdown :: WriterOptions -> [Block] -> State WriterState Doc +bulletListItemToMarkdown opts items = do + contents <- blockListToMarkdown opts items + return $ hang (text "- ") (writerTabStop opts) contents -- | Convert ordered list item (a list of blocks) to markdown. -orderedListItemToMarkdown :: Int -- ^ tab stop - -> Int -- ^ ordinal number of list item - -> [Block] -- ^ list item (list of blocks) - -> Doc -orderedListItemToMarkdown tabStop num list = - hang (text ((show num) ++ "." ++ spacer)) tabStop - (vcat (map (blockToMarkdown tabStop) list)) - where spacer = if (num < 10) then " " else "" +orderedListItemToMarkdown :: WriterOptions -- ^ options + -> Int -- ^ ordinal number of list item + -> [Block] -- ^ list item (list of blocks) + -> State WriterState Doc +orderedListItemToMarkdown opts num items = do + contents <- blockListToMarkdown opts items + let spacer = if (num < 10) then " " else "" + return $ hang (text ((show num) ++ "." ++ spacer)) (writerTabStop opts) + contents + +-- | Convert list of Pandoc block elements to markdown. +blockListToMarkdown :: WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> State WriterState Doc +blockListToMarkdown opts blocks = + 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' -- | Convert list of Pandoc inline elements to markdown. -inlineListToMarkdown :: [Inline] -> Doc -inlineListToMarkdown lst = hcat $ map inlineToMarkdown lst +inlineListToMarkdown :: WriterOptions -> [Inline] -> State WriterState Doc +inlineListToMarkdown opts lst = mapM (inlineToMarkdown opts) lst >>= (return . hcat) -- | Convert Pandoc inline element to markdown. -inlineToMarkdown :: Inline -> Doc -inlineToMarkdown (Emph lst) = text "*" <> - (inlineListToMarkdown lst) <> text "*" -inlineToMarkdown (Strong lst) = text "**" <> - (inlineListToMarkdown lst) <> text "**" -inlineToMarkdown (Quoted SingleQuote lst) = char '\'' <> - (inlineListToMarkdown lst) <> char '\'' -inlineToMarkdown (Quoted DoubleQuote lst) = char '"' <> - (inlineListToMarkdown lst) <> char '"' -inlineToMarkdown EmDash = text "--" -inlineToMarkdown EnDash = char '-' -inlineToMarkdown Apostrophe = char '\'' -inlineToMarkdown Ellipses = text "..." -inlineToMarkdown (Code str) = +inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc +inlineToMarkdown opts (Emph lst) = do + contents <- inlineListToMarkdown opts lst + return $ text "*" <> contents <> text "*" +inlineToMarkdown opts (Strong lst) = do + contents <- inlineListToMarkdown opts lst + return $ text "**" <> contents <> text "**" +inlineToMarkdown opts (Quoted SingleQuote lst) = do + contents <- inlineListToMarkdown opts lst + return $ char '\'' <> contents <> char '\'' +inlineToMarkdown opts (Quoted DoubleQuote lst) = do + contents <- inlineListToMarkdown opts lst + return $ char '"' <> contents <> char '"' +inlineToMarkdown opts EmDash = return $ text "--" +inlineToMarkdown opts EnDash = return $ char '-' +inlineToMarkdown opts Apostrophe = return $ char '\'' +inlineToMarkdown opts Ellipses = return $ text "..." +inlineToMarkdown opts (Code str) = let tickGroups = filter (\s -> '`' `elem` s) $ group str longest = if null tickGroups then 0 else maximum $ map length tickGroups marker = replicate (longest + 1) '`' - spacer = if (longest == 0) then "" else " " in - text (marker ++ spacer ++ str ++ spacer ++ marker) -inlineToMarkdown (Str str) = text $ escapeString str -inlineToMarkdown (TeX str) = text str -inlineToMarkdown (HtmlInline str) = text str -inlineToMarkdown (LineBreak) = text " \n" -inlineToMarkdown Space = char ' ' -inlineToMarkdown (Link txt (Src src tit)) = - let linktext = if (null txt) || (txt == [Str ""]) - then text "link" - else inlineListToMarkdown txt - linktitle = if null tit - then empty - else text (" \"" ++ tit ++ "\"") - srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src in - if (null tit) && (txt == [Str srcSuffix]) - then char '<' <> text srcSuffix <> char '>' - else char '[' <> linktext <> char ']' <> char '(' <> text src <> - linktitle <> char ')' -inlineToMarkdown (Link txt (Ref ref)) = - let first = char '[' <> inlineListToMarkdown txt <> char ']' - second = if (txt == ref) - then text "[]" - else char '[' <> inlineListToMarkdown ref <> char ']' in - first <> second -inlineToMarkdown (Image alternate (Src source tit)) = - let alt = if (null alternate) || (alternate == [Str ""]) - then text "image" - else inlineListToMarkdown alternate in - char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <> - (if tit /= "" - then text (" \"" ++ tit ++ "\"") - else empty) <> char ')' -inlineToMarkdown (Image alternate (Ref ref)) = - char '!' <> inlineToMarkdown (Link alternate (Ref ref)) -inlineToMarkdown (NoteRef ref) = - text "[^" <> text (escapeString ref) <> char ']' + spacer = if (longest == 0) then "" else " " in + return $ text (marker ++ spacer ++ str ++ spacer ++ marker) +inlineToMarkdown opts (Str str) = return $ text $ escapeString str +inlineToMarkdown opts (TeX str) = return $ text str +inlineToMarkdown opts (HtmlInline str) = return $ text str +inlineToMarkdown opts (LineBreak) = return $ text " \n" +inlineToMarkdown opts Space = return $ char ' ' +inlineToMarkdown opts (Link txt (src, tit)) = do + linktext <- inlineListToMarkdown opts txt + let linktitle = if null tit then empty else text $ " \"" ++ tit ++ "\"" + let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src + let useRefLinks = writerReferenceLinks opts + let useAuto = null tit && txt == [Str srcSuffix] + ref <- if useRefLinks then getReference txt (src, tit) else return [] + reftext <- inlineListToMarkdown opts ref + 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 ')' +inlineToMarkdown opts (Image alternate (source, tit)) = do + let txt = if (null alternate) || (alternate == [Str ""]) || + (alternate == [Str source]) -- to prevent autolinks + then [Str "image"] + else alternate + linkPart <- inlineToMarkdown opts (Link txt (source, tit)) + return $ char '!' <> linkPart +inlineToMarkdown opts (Note contents) = do + modify (\(notes, refs) -> (contents:notes, refs)) -- add to notes in state + (notes, _) <- get + let ref = show $ (length notes) + return $ text "[^" <> text ref <> char ']' diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 27d1a596a..a00ab1cc6 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -30,204 +30,245 @@ Conversion of 'Pandoc' documents to reStructuredText. reStructuredText: <http://docutils.sourceforge.net/rst.html> -} module Text.Pandoc.Writers.RST ( - writeRST - ) where + writeRST + ) where import Text.Pandoc.Definition -import Text.Pandoc.Shared -import List ( nubBy ) +import Text.Pandoc.Shared +import Data.List ( group, isPrefixOf, drop, find ) import Text.PrettyPrint.HughesPJ hiding ( Str ) +import Control.Monad.State --- | Convert Pandoc to reStructuredText. +type Notes = [[Block]] +type Refs = KeyTable +type WriterState = (Notes, Refs, Refs) -- first Refs is links, second pictures + +-- | Convert Pandoc to RST. writeRST :: WriterOptions -> Pandoc -> String -writeRST options (Pandoc meta blocks) = - let (main, refs) = unzip $ map (blockToRST (writerTabStop options)) - (reformatBlocks $ replaceReferenceLinks blocks) - top = if (writerStandalone options) - then (metaToRST meta) $$ text (writerHeader options) - else empty in - -- remove duplicate keys - let refs' = nubBy (\x y -> (render x) == (render y)) refs in - let body = text (writerIncludeBefore options) <> - vcat main $$ text (writerIncludeAfter options) in - render $ top <> body $$ vcat refs' $$ text "\n" - --- | Escape special RST characters. +writeRST opts document = + render $ evalState (pandocToRST opts document) ([],[],[]) + +-- | Return RST representation of document. +pandocToRST :: WriterOptions -> Pandoc -> State WriterState Doc +pandocToRST 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 + metaBlock <- metaToRST opts meta + let head = if (writerStandalone opts) + then metaBlock $$ text (writerHeader opts) + else empty + body <- blockListToRST opts blocks + (notes, _, _) <- get + notes' <- notesToRST opts (reverse notes) + (_, refs, pics) <- get -- note that the notes may contain refs + refs' <- keyTableToRST opts (reverse refs) + pics' <- pictTableToRST opts (reverse pics) + return $ head <> (before' $$ body $$ notes' <> text "\n" $$ refs' $$ + pics' $$ after') + +-- | Return RST representation of reference key table. +keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc +keyTableToRST opts refs = + mapM (keyToRST opts) refs >>= (return . vcat) + +-- | Return RST representation of a reference key. +keyToRST :: WriterOptions + -> ([Inline], (String, String)) + -> State WriterState Doc +keyToRST opts (label, (src, tit)) = do + label' <- inlineListToRST opts label + return $ text ".. _" <> label' <> text ": " <> text src + +-- | Return RST representation of notes. +notesToRST :: WriterOptions -> [[Block]] -> State WriterState Doc +notesToRST opts notes = + mapM (\(num, note) -> noteToRST opts num note) (zip [1..] notes) >>= + (return . vcat) + +-- | Return RST representation of a note. +noteToRST :: WriterOptions -> Int -> [Block] -> State WriterState Doc +noteToRST opts num note = do + contents <- blockListToRST opts note + let marker = text ".. [" <> text (show num) <> text "] " + return $ hang marker 3 contents + +-- | Return RST representation of picture reference table. +pictTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc +pictTableToRST opts refs = + mapM (pictToRST opts) refs >>= (return . vcat) + +-- | Return RST representation of a picture substitution reference. +pictToRST :: WriterOptions + -> ([Inline], (String, String)) + -> State WriterState Doc +pictToRST opts (label, (src, _)) = do + label' <- inlineListToRST opts label + return $ text ".. " <> char '|' <> label' <> char '|' <> text " image:: " <> + text src + +-- | Take list of inline elements and return wrapped doc. +wrappedRST :: WriterOptions -> [Inline] -> State WriterState Doc +wrappedRST opts inlines = + mapM (wrappedRSTSection opts) (splitBy LineBreak inlines) >>= + (return . vcat) + +wrappedRSTSection :: WriterOptions -> [Inline] -> State WriterState Doc +wrappedRSTSection opts sect = do + let chunks = splitBy Space sect + chunks' <- mapM (inlineListToRST opts) chunks + return $ fsep chunks' + +-- | Escape special characters for RST. escapeString :: String -> String escapeString = backslashEscape "`\\|*_" --- | Convert list of inline elements into one 'Doc' of wrapped text --- and another containing references. -wrappedRST :: [Inline] -> (Doc, Doc) -wrappedRST lst = - let wrap_section sec = fsep $ map (fst . inlineListToRST) $ - (splitBy Space sec) in - ((vcat $ map wrap_section $ (splitBy LineBreak lst)), - vcat $ map (snd . inlineToRST) lst) - --- | Remove reference keys, and make sure there are blanks before each list. -reformatBlocks :: [Block] -> [Block] -reformatBlocks [] = [] -reformatBlocks ((Plain x):(OrderedList y):rest) = - (Para x):(reformatBlocks ((OrderedList y):rest)) -reformatBlocks ((Plain x):(BulletList y):rest) = - (Para x):(reformatBlocks ((BulletList y):rest)) -reformatBlocks ((OrderedList x):rest) = - (OrderedList (map reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((BulletList x):rest) = - (BulletList (map reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((BlockQuote x):rest) = - (BlockQuote (reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((Note ref x):rest) = - (Note ref (reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest -reformatBlocks (x:rest) = x:(reformatBlocks rest) - --- | Convert bibliographic information to 'Doc'. -metaToRST :: Meta -> Doc -metaToRST (Meta title authors date) = - (titleToRST title) <> (authorsToRST authors) <> (dateToRST date) - --- | Convert title to 'Doc'. -titleToRST :: [Inline] -> Doc -titleToRST [] = empty -titleToRST lst = - let title = fst $ inlineListToRST lst in - let titleLength = length $ render title in - let border = text (replicate titleLength '=') in - border <> char '\n' <> title <> char '\n' <> border <> text "\n\n" - --- | Convert author list to 'Doc'. -authorsToRST :: [String] -> Doc -authorsToRST [] = empty -authorsToRST (first:rest) = text ":Author: " <> text first <> - char '\n' <> (authorsToRST rest) - --- | Convert date to 'Doc'. -dateToRST :: String -> Doc -dateToRST [] = empty -dateToRST str = text ":Date: " <> text (escapeString str) <> char '\n' - --- | Convert Pandoc block element to a 'Doc' containing the main text and --- another one containing any references. -blockToRST :: Int -- ^ tab stop - -> Block -- ^ block element to convert - -> (Doc, Doc) -- ^ first element is text, second is references for end of file -blockToRST tabStop Null = (empty, empty) -blockToRST tabStop (Plain lst) = wrappedRST lst -blockToRST tabStop (Para [TeX str]) = -- raw latex block +-- | Convert bibliographic information into RST header. +metaToRST :: WriterOptions -> Meta -> State WriterState Doc +metaToRST opts (Meta title authors date) = do + title' <- titleToRST opts title + authors' <- authorsToRST authors + date' <- dateToRST date + return $ title' <> authors' <> date' + +titleToRST :: WriterOptions -> [Inline] -> State WriterState Doc +titleToRST opts [] = return empty +titleToRST opts lst = do + contents <- inlineListToRST opts lst + let titleLength = length $ render contents + let border = text (replicate titleLength '=') + return $ border <> char '\n' <> contents <> char '\n' <> border <> text "\n\n" + +authorsToRST :: [String] -> State WriterState Doc +authorsToRST [] = return empty +authorsToRST (first:rest) = do + rest' <- authorsToRST rest + return $ text ":Author: " <> text first <> char '\n' <> rest' + +dateToRST :: String -> State WriterState Doc +dateToRST [] = return empty +dateToRST str = return $ text ":Date: " <> text (escapeString str) <> char '\n' + +-- | Convert Pandoc block element to RST. +blockToRST :: WriterOptions -- ^ Options + -> Block -- ^ Block element + -> State WriterState Doc +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 - (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty) -blockToRST tabStop (Para lst) = ( (fst $ wrappedRST lst) <> (text "\n"), - snd $ wrappedRST lst ) -blockToRST tabStop (BlockQuote lst) = - let (main, refs) = unzip $ map (blockToRST tabStop) lst in - ((nest tabStop $ vcat $ main) <> text "\n", vcat refs) -blockToRST tabStop (Note ref blocks) = - let (main, refs) = unzip $ map (blockToRST tabStop) blocks in - ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), - vcat refs) -blockToRST tabStop (Key txt (Src src tit)) = - (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here -blockToRST tabStop (CodeBlock str) = (hang (text "::\n") tabStop - (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty) -blockToRST tabStop (RawHtml str) = + 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 - (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty) -blockToRST tabStop (BulletList lst) = - let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in - (vcat main <> text "\n", vcat refs) -blockToRST tabStop (OrderedList lst) = - let (main, refs) = unzip $ zipWith (orderedListItemToRST tabStop) - (enumFromTo 1 (length lst)) lst in - (vcat main <> text "\n", vcat refs) -blockToRST tabStop HorizontalRule = (text "--------------\n", empty) -blockToRST tabStop (Header level lst) = - let (headerText, refs) = inlineListToRST lst in - let headerLength = length $ render headerText in - let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in - let border = text $ replicate headerLength headerChar in - (headerText <> char '\n' <> border <> char '\n', refs) -blockToRST tabStop (Table caption _ _ headers rows) = - blockToRST tabStop (Para [Str "pandoc: TABLE unsupported in RST writer"]) - - --- | Convert bullet list item (list of blocks) to reStructuredText. --- Returns a pair of 'Doc', the first the main text, the second references -bulletListItemToRST :: Int -- ^ tab stop - -> [Block] -- ^ list item (list of blocks) - -> (Doc, Doc) -bulletListItemToRST tabStop list = - let (main, refs) = unzip $ map (blockToRST tabStop) list in - (hang (text "- ") tabStop (vcat main), (vcat refs)) - --- | Convert an ordered list item (list of blocks) to reStructuredText. --- Returns a pair of 'Doc', the first the main text, the second references -orderedListItemToRST :: Int -- ^ tab stop - -> Int -- ^ ordinal number of list item - -> [Block] -- ^ list item (list of blocks) - -> (Doc, Doc) -orderedListItemToRST tabStop num list = - let (main, refs) = unzip $ map (blockToRST tabStop) list - spacer = if (length (show num) < 2) then " " else "" in - (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs)) - --- | Convert a list of inline elements to reStructuredText. --- Returns a pair of 'Doc', the first the main text, the second references. -inlineListToRST :: [Inline] -> (Doc, Doc) -inlineListToRST lst = let (main, refs) = unzip $ map inlineToRST lst in - (hcat main, hcat refs) - --- | Convert an inline element to reStructuredText. --- Returns a pair of 'Doc', the first the main text, the second references. -inlineToRST :: Inline -> (Doc, Doc) -- second Doc is list of refs for end of file -inlineToRST (Emph lst) = let (main, refs) = inlineListToRST lst in - (text "*" <> main <> text "*", refs) -inlineToRST (Strong lst) = let (main, refs) = inlineListToRST lst in - (text "**" <> main <> text "**", refs) -inlineToRST (Quoted SingleQuote lst) = let (main, refs) = inlineListToRST lst in - (char '\'' <> main <> char '\'', refs) -inlineToRST (Quoted DoubleQuote lst) = let (main, refs) = inlineListToRST lst in - (char '"' <> main <> char '"', refs) -inlineToRST EmDash = (text "--", empty) -inlineToRST EnDash = (char '-', empty) -inlineToRST Apostrophe = (char '\'', empty) -inlineToRST Ellipses = (text "...", empty) -inlineToRST (Code str) = (text $ "``" ++ str ++ "``", empty) -inlineToRST (Str str) = (text $ escapeString str, empty) -inlineToRST (TeX str) = (text str, empty) -inlineToRST (HtmlInline str) = (empty, empty) -inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks -inlineToRST Space = (char ' ', empty) --- --- Note: can assume reference links have been replaced where possible --- with explicit links. --- -inlineToRST (Link txt (Src src tit)) = - let (linktext, ref') = if (null txt) || (txt == [Str ""]) - then (text "link", empty) - else inlineListToRST $ normalizeSpaces txt in - let link = char '`' <> linktext <> text "`_" - linktext' = render linktext in - let linktext'' = if (':' `elem` linktext') - then "`" ++ linktext' ++ "`" - else linktext' in - let ref = text ".. _" <> text linktext'' <> text ": " <> text src in - (link, ref' $$ ref) -inlineToRST (Link txt (Ref ref)) = - let (linktext, refs1) = inlineListToRST txt - (reftext, refs2) = inlineListToRST ref in - (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2) -inlineToRST (Image alternate (Src source tit)) = - let (alt, ref') = if (null alternate) || (alternate == [Str ""]) - then (text "image", empty) - else inlineListToRST $ normalizeSpaces alternate in - let link = char '|' <> alt <> char '|' in - let ref = text ".. " <> link <> text " image:: " <> text source in - (link, ref' $$ ref) --- The following case won't normally occur... -inlineToRST (Image alternate (Ref ref)) = - let (alttext, refs1) = inlineListToRST alternate - (reftext, refs2) = inlineListToRST ref in - (char '|' <> alttext <> char '|', refs1 $$ refs2) -inlineToRST (NoteRef ref) = - (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty) + 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 border = text $ replicate headerLength headerChar + return $ contents <> char '\n' <> border <> char '\n' +blockToRST opts (CodeBlock str) = return $ (text "::\n") $$ text "" $$ + (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n" +blockToRST opts (BlockQuote blocks) = do + contents <- blockListToRST opts blocks + return $ (nest (writerTabStop opts) contents) <> text "\n" +blockToRST opts (Table caption _ _ headers rows) = blockToRST opts + (Para [Str "pandoc: TABLE unsupported in RST writer"]) +blockToRST opts (BulletList items) = do + contents <- mapM (bulletListItemToRST opts) items + return $ (vcat contents) <> text "\n" +blockToRST opts (OrderedList items) = do + contents <- mapM (\(item, num) -> orderedListItemToRST opts item num) $ + zip [1..] items + return $ (vcat contents) <> text "\n" + +-- | Convert bullet list item (list of blocks) to RST. +bulletListItemToRST :: WriterOptions -> [Block] -> State WriterState Doc +bulletListItemToRST opts items = do + contents <- blockListToRST opts items + return $ hang (text "- ") (writerTabStop opts) contents + +-- | Convert ordered list item (a list of blocks) to RST. +orderedListItemToRST :: WriterOptions -- ^ options + -> Int -- ^ ordinal number of list item + -> [Block] -- ^ list item (list of blocks) + -> State WriterState Doc +orderedListItemToRST opts num items = do + contents <- blockListToRST opts items + let spacer = if (num < 10) then " " else "" + return $ hang (text ((show num) ++ "." ++ spacer)) (writerTabStop opts) + contents + +-- | Convert list of Pandoc block elements to RST. +blockListToRST :: WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> State WriterState Doc +blockListToRST opts blocks = + 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) + +-- | Convert Pandoc inline element to RST. +inlineToRST :: WriterOptions -> Inline -> State WriterState Doc +inlineToRST opts (Emph lst) = do + contents <- inlineListToRST opts lst + return $ text "*" <> contents <> text "*" +inlineToRST opts (Strong lst) = do + contents <- inlineListToRST opts lst + return $ text "**" <> contents <> text "**" +inlineToRST opts (Quoted SingleQuote lst) = do + contents <- inlineListToRST opts lst + return $ char '\'' <> contents <> char '\'' +inlineToRST opts (Quoted DoubleQuote lst) = do + contents <- inlineListToRST opts lst + return $ char '"' <> contents <> char '"' +inlineToRST opts EmDash = return $ text "--" +inlineToRST opts EnDash = return $ char '-' +inlineToRST opts Apostrophe = return $ char '\'' +inlineToRST opts Ellipses = return $ text "..." +inlineToRST opts (Code str) = return $ text $ "``" ++ str ++ "``" +inlineToRST opts (Str str) = return $ text $ escapeString str +inlineToRST opts (TeX str) = return $ text str +inlineToRST opts (HtmlInline str) = return empty +inlineToRST opts (LineBreak) = return $ text " " -- RST doesn't have linebreaks +inlineToRST opts Space = return $ char ' ' +inlineToRST opts (Link txt (src, tit)) = do + let useReferenceLinks = writerReferenceLinks opts + let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src + let useAuto = null tit && txt == [Str srcSuffix] + (notes, refs, pics) <- get + linktext <- inlineListToRST opts $ normalizeSpaces txt + link <- if useReferenceLinks + then do let refs' = if (txt, (src, tit)) `elem` refs + then refs + else (txt, (src, tit)):refs + put (notes, refs', pics) + return $ char '`' <> linktext <> text "`_" + else return $ char '`' <> linktext <> text " <" <> + text src <> text ">`_" + return link +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) + then [Str $ "image" ++ show (length refs)] + else alternate + let pics' = if (txt, (source, tit)) `elem` pics + then pics + else (txt, (source, tit)):pics + put (notes, refs, pics') + label <- inlineListToRST opts txt + return $ char '|' <> label <> char '|' +inlineToRST opts (Note contents) = do + -- add to notes in state + modify (\(notes, refs, pics) -> (contents:notes, refs, pics)) + (notes, _, _) <- get + let ref = show $ (length notes) + return $ text " [" <> text ref <> text "]_" diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 2dddb857b..769ceeaf5 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -17,7 +17,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : + Module : Text.Pandoc.Writers.RTF Copyright : Copyright (C) 2006 John MacFarlane License : GNU GPL, version 2 or above @@ -27,26 +27,21 @@ 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 List ( isSuffixOf ) -import Char ( ord, chr ) +import Data.List ( isSuffixOf ) +import Data.Char ( ord, chr ) -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String writeRTF options (Pandoc meta blocks) = - -- assumes all notes are at outer level - let notes = filter isNoteBlock blocks in let head = if writerStandalone options - then rtfHeader notes (writerHeader options) meta + then rtfHeader (writerHeader options) meta else "" foot = if writerStandalone options then "\n}\n" else "" - body = (writerIncludeBefore options) ++ (concatMap (blockToRTF notes 0) - (replaceReferenceLinks blocks)) ++ + body = (writerIncludeBefore options) ++ concatMap (blockToRTF 0) blocks ++ (writerIncludeAfter options) in head ++ body ++ foot @@ -120,15 +115,14 @@ orderedMarkers indent = otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z'] -- | Returns RTF header. -rtfHeader :: [Block] -- ^ list of note blocks - -> String -- ^ header text +rtfHeader :: String -- ^ header text -> Meta -- ^ bibliographic information -> String -rtfHeader notes headerText (Meta title authors date) = +rtfHeader headerText (Meta title authors date) = let titletext = if null title then "" else rtfPar 0 0 ("\\qc \\b \\fs36 " ++ - inlineListToRTF notes title) + inlineListToRTF title) authorstext = if null authors then "" else rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" @@ -142,35 +136,32 @@ rtfHeader notes headerText (Meta title authors date) = headerText ++ titletext ++ authorstext ++ datetext ++ spacer -- | Convert Pandoc block element to RTF. -blockToRTF :: [Block] -- ^ list of note blocks - -> Int -- ^ indent level +blockToRTF :: Int -- ^ indent level -> Block -- ^ block to convert -> String -blockToRTF notes indent Null = "" -blockToRTF notes indent (Plain lst) = - rtfCompact indent 0 (inlineListToRTF notes lst) -blockToRTF notes indent (Para lst) = - rtfPar indent 0 (inlineListToRTF notes lst) -blockToRTF notes indent (BlockQuote lst) = - concatMap (blockToRTF notes (indent + indentIncrement)) lst -blockToRTF notes indent (Note ref lst) = "" -- shouldn't be any aftr filtering -blockToRTF notes indent (Key _ _) = "" -blockToRTF notes indent (CodeBlock str) = +blockToRTF indent Null = "" +blockToRTF indent (Plain lst) = + rtfCompact indent 0 (inlineListToRTF lst) +blockToRTF indent (Para lst) = + rtfPar indent 0 (inlineListToRTF lst) +blockToRTF indent (BlockQuote lst) = + concatMap (blockToRTF (indent + indentIncrement)) lst +blockToRTF indent (CodeBlock str) = rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str)) -blockToRTF notes indent (RawHtml str) = "" -blockToRTF notes indent (BulletList lst) = +blockToRTF indent (RawHtml str) = "" +blockToRTF indent (BulletList lst) = spaceAtEnd $ - concatMap (listItemToRTF notes indent (bulletMarker indent)) lst -blockToRTF notes indent (OrderedList lst) = + concatMap (listItemToRTF indent (bulletMarker indent)) lst +blockToRTF indent (OrderedList lst) = spaceAtEnd $ concat $ - zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst -blockToRTF notes indent HorizontalRule = + zipWith (listItemToRTF indent) (orderedMarkers indent) lst +blockToRTF indent HorizontalRule = rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash" -blockToRTF notes indent (Header level lst) = +blockToRTF indent (Header level lst) = rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ - (inlineListToRTF notes lst)) -blockToRTF notes indent (Table caption _ _ headers rows) = - blockToRTF notes indent (Para [Str "pandoc: TABLE unsupported in RST writer"]) + (inlineListToRTF lst)) +blockToRTF indent (Table caption _ _ headers rows) = + blockToRTF indent (Para [Str "pandoc: TABLE unsupported in RST writer"]) -- | Ensure that there's the same amount of space after compact -- lists as after regular lists. @@ -181,16 +172,15 @@ spaceAtEnd str = else str -- | Convert list item (list of blocks) to RTF. -listItemToRTF :: [Block] -- ^ list of note blocks - -> Int -- ^ indent level +listItemToRTF :: Int -- ^ indent level -> String -- ^ list start marker -> [Block] -- ^ list item (list of blocks) -> [Char] -listItemToRTF notes indent marker [] = +listItemToRTF indent marker [] = rtfCompact (indent + listIncrement) (0 - listIncrement) (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") -listItemToRTF notes indent marker list = - let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in +listItemToRTF indent marker list = + let (first:rest) = map (blockToRTF (indent + listIncrement)) 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" ++ @@ -200,47 +190,36 @@ listItemToRTF notes indent marker list = modFirst ++ (concat rest) -- | Convert list of inline items to RTF. -inlineListToRTF :: [Block] -- ^ list of note blocks - -> [Inline] -- ^ list of inlines to convert +inlineListToRTF :: [Inline] -- ^ list of inlines to convert -> String -inlineListToRTF notes lst = concatMap (inlineToRTF notes) lst +inlineListToRTF lst = concatMap inlineToRTF lst -- | Convert inline item to RTF. -inlineToRTF :: [Block] -- ^ list of note blocks - -> Inline -- ^ inline to convert +inlineToRTF :: Inline -- ^ inline to convert -> String -inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} " -inlineToRTF notes (Strong lst) = - "{\\b " ++ (inlineListToRTF notes lst) ++ "} " -inlineToRTF notes (Quoted SingleQuote lst) = - "\\u8216'" ++ (inlineListToRTF notes lst) ++ "\\u8217'" -inlineToRTF notes (Quoted DoubleQuote lst) = - "\\u8220\"" ++ (inlineListToRTF notes lst) ++ "\\u8221\"" -inlineToRTF notes Apostrophe = "\\u8217'" -inlineToRTF notes Ellipses = "\\u8230?" -inlineToRTF notes EmDash = "\\u8212-" -inlineToRTF notes EnDash = "\\u8211-" -inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} " -inlineToRTF notes (Str str) = stringToRTF str -inlineToRTF notes (TeX str) = latexToRTF str -inlineToRTF notes (HtmlInline str) = "" -inlineToRTF notes (LineBreak) = "\\line " -inlineToRTF notes Space = " " -inlineToRTF notes (Link text (Src src tit)) = +inlineToRTF (Emph lst) = "{\\i " ++ (inlineListToRTF lst) ++ "} " +inlineToRTF (Strong lst) = + "{\\b " ++ (inlineListToRTF lst) ++ "} " +inlineToRTF (Quoted SingleQuote lst) = + "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'" +inlineToRTF (Quoted DoubleQuote lst) = + "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\"" +inlineToRTF Apostrophe = "\\u8217'" +inlineToRTF Ellipses = "\\u8230?" +inlineToRTF EmDash = "\\u8212-" +inlineToRTF EnDash = "\\u8211-" +inlineToRTF (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} " +inlineToRTF (Str str) = stringToRTF str +inlineToRTF (TeX str) = latexToRTF str +inlineToRTF (HtmlInline str) = "" +inlineToRTF (LineBreak) = "\\line " +inlineToRTF Space = " " +inlineToRTF (Link text (src, tit)) = "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ - "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF notes text) ++ "\n}}}\n" -inlineToRTF notes (Link text (Ref ref)) = - "[" ++ (inlineListToRTF notes text) ++ "][" ++ - (inlineListToRTF notes ref) ++ "]" -- this is what markdown does -inlineToRTF notes (Image alternate (Src source tit)) = + "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n" +inlineToRTF (Image alternate (source, tit)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" -inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ - (inlineListToRTF notes alternate) ++ "][" ++ - (inlineListToRTF notes ref) ++ "]" -inlineToRTF [] (NoteRef ref) = "" -inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) = - if firstref == ref - then "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ - (concatMap (blockToRTF rest 0) firstblocks) ++ "}" - else inlineToRTF rest (NoteRef ref) +inlineToRTF (Note contents) = + "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ + (concatMap (blockToRTF 0) contents) ++ "}" |