aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/RST.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers/RST.hs')
-rw-r--r--src/Text/Pandoc/Writers/RST.hs175
1 files changed, 98 insertions, 77 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index cc2bc6499..e42279ef4 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -1,4 +1,16 @@
--- | Converts Pandoc to reStructuredText.
+{- |
+ Module : Text.Pandoc.Writers.RST
+ Copyright : Copyright (C) 2006 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
+ Stability : unstable
+ Portability : portable
+
+Conversion of 'Pandoc' documents to reStructuredText.
+
+reStructuredText: http://docutils.sourceforge.net/rst.html
+-}
module Text.Pandoc.Writers.RST (
writeRST
) where
@@ -10,40 +22,44 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
-- | Convert Pandoc to reStructuredText.
writeRST :: WriterOptions -> Pandoc -> String
writeRST options (Pandoc meta blocks) =
- let (main, refs) = unzip $ map (blockToRST (writerTabStop options))
+ 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"
+ 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.
escapeString :: String -> String
escapeString = backslashEscape "`\\|*_"
--- | Convert list of inline elements into one 'Doc' of wrapped text and another
--- containing references.
+-- | Convert list of inline elements into one 'Doc' of wrapped text
+-- and another containing references.
wrappedRST :: [Inline] -> (Doc, Doc)
wrappedRST lst =
- let words = splitBySpace lst in
- (fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst))
+ let words = splitBySpace lst in
+ ( fsep $ map (fcat . (map (fst . inlineToRST))) words,
+ 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 ((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 ((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)
@@ -56,15 +72,16 @@ metaToRST (Meta title authors date) =
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"
+ 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)
+authorsToRST (first:rest) = text ":Author: " <> text first <>
+ char '\n' <> (authorsToRST rest)
-- | Convert date to 'Doc'.
dateToRST :: String -> Doc
@@ -80,36 +97,38 @@ blockToRST tabStop Blank = (text "\n", empty)
blockToRST tabStop Null = (empty, empty)
blockToRST tabStop (Plain lst) = wrappedRST lst
blockToRST tabStop (Para [TeX str]) = -- raw latex block
- 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)
+ 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)
+ 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)
+ 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)
+ (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) =
- 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)
+ 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)
+ 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)
+ 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)
+ 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)
-- | Convert bullet list item (list of blocks) to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references
@@ -117,8 +136,8 @@ 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))
+ 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
@@ -127,9 +146,9 @@ orderedListItemToRST :: Int -- ^ tab stop
-> [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))
+ 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.
@@ -151,39 +170,41 @@ 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.
+-- 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 (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 [])) =
- let (linktext, refs) = inlineListToRST txt in
- (char '[' <> linktext <> char ']', refs)
+ let (linktext, refs) = inlineListToRST txt in
+ (char '[' <> linktext <> char ']', refs)
inlineToRST (Link txt (Ref ref)) =
- let (linktext, refs1) = inlineListToRST txt
- (reftext, refs2) = inlineListToRST ref in
- (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)
+ 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)
+ 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)
inlineToRST (Image alternate (Ref [])) =
- let (alttext, refs) = inlineListToRST alternate in
- (char '|' <> alttext <> char '|', refs)
+ let (alttext, refs) = inlineListToRST alternate in
+ (char '|' <> alttext <> char '|', refs)
-- 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)
+ 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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 12:01:33 +0000