summaryrefslogtreecommitdiff
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.hs177
1 files changed, 84 insertions, 93 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index e79f97b33..d4adaa929 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -32,10 +33,9 @@ reStructuredText: <http://docutils.sourceforge.net/rst.html>
module Text.Pandoc.Writers.RST ( writeRST) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
-import Text.Pandoc.Blocks
import Text.Pandoc.Templates (renderTemplate)
-import Data.List ( isPrefixOf, isSuffixOf, intersperse, transpose )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Data.List ( isPrefixOf, intersperse, transpose )
+import Text.Pandoc.Pretty
import Control.Monad.State
import Control.Applicative ( (<$>) )
@@ -70,13 +70,16 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
refs <- liftM (reverse . stLinks) get >>= refsToRST
pics <- liftM (reverse . stImages) get >>= pictRefsToRST
hasMath <- liftM stHasMath get
- let main = render $ foldl ($+$) empty $ [body, notes, refs, pics]
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = writerVariables opts ++
[ ("body", main)
- , ("title", render title)
- , ("date", render date) ] ++
+ , ("title", render Nothing title)
+ , ("date", render colwidth date) ] ++
[ ("math", "yes") | hasMath ] ++
- [ ("author", render a) | a <- authors ]
+ [ ("author", render colwidth a) | a <- authors ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main
@@ -84,49 +87,40 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
-- | Return RST representation of reference key table.
refsToRST :: Refs -> State WriterState Doc
refsToRST refs = mapM keyToRST refs >>= return . vcat
-
+
-- | Return RST representation of a reference key.
keyToRST :: ([Inline], (String, String))
-> State WriterState Doc
keyToRST (label, (src, _)) = do
label' <- inlineListToRST label
- let label'' = if ':' `elem` (render label')
+ let label'' = if ':' `elem` (render Nothing label')
then char '`' <> label' <> char '`'
else label'
- return $ text ".. _" <> label'' <> text ": " <> text src
+ return $ ".. _" <> label'' <> ": " <> text src
-- | Return RST representation of notes.
notesToRST :: [[Block]] -> State WriterState Doc
notesToRST notes =
- mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>=
- return . vcat
+ mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>=
+ return . vsep
-- | Return RST representation of a note.
noteToRST :: Int -> [Block] -> State WriterState Doc
noteToRST num note = do
contents <- blockListToRST note
- let marker = text ".. [" <> text (show num) <> text "]"
+ let marker = ".. [" <> text (show num) <> "]"
return $ marker $$ nest 3 contents
-- | Return RST representation of picture reference table.
pictRefsToRST :: Refs -> State WriterState Doc
pictRefsToRST refs = mapM pictToRST refs >>= return . vcat
-
+
-- | Return RST representation of a picture substitution reference.
pictToRST :: ([Inline], (String, String))
-> State WriterState Doc
pictToRST (label, (src, _)) = do
label' <- inlineListToRST 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 = do
- lineBreakDoc <- inlineToRST LineBreak
- chunks <- mapM (wrapIfNeeded opts inlineListToRST)
- (splitBy LineBreak inlines)
- return $ vcat $ intersperse lineBreakDoc chunks
+ return $ ".. |" <> label' <> "| image:: " <> text src
-- | Escape special characters for RST.
escapeString :: String -> String
@@ -136,69 +130,66 @@ titleToRST :: [Inline] -> State WriterState Doc
titleToRST [] = return empty
titleToRST lst = do
contents <- inlineListToRST lst
- let titleLength = length $ render contents
+ let titleLength = length $ (render Nothing contents :: String)
let border = text (replicate titleLength '=')
- return $ border $+$ contents $+$ border
+ return $ border $$ contents $$ border
-- | Convert Pandoc block element to RST.
blockToRST :: Block -- ^ Block element
-> State WriterState Doc
blockToRST Null = return empty
-blockToRST (Plain inlines) = do
- opts <- get >>= (return . stOptions)
- wrappedRST opts inlines
+blockToRST (Plain inlines) = inlineListToRST inlines
blockToRST (Para [Image txt (src,tit)]) = do
capt <- inlineListToRST txt
- let fig = text "figure:: " <> text src
- let align = text ":align: center"
- let alt = text ":alt: " <> if null tit then capt else text tit
- return $ (text ".. " <> (fig $$ align $$ alt $$ text "" $$ capt)) $$ text ""
+ let fig = "figure:: " <> text src
+ let align = ":align: center"
+ let alt = ":alt: " <> if null tit then capt else text tit
+ return $ hang 3 ".. " $ fig $$ align $$ alt $+$ capt $$ blankline
blockToRST (Para inlines) = do
- opts <- get >>= (return . stOptions)
- contents <- wrappedRST opts inlines
- return $ contents <> text "\n"
-blockToRST (RawHtml str) =
- let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in
- return $ (text "\n.. raw:: html\n") $$ (nest 3 $ vcat $ map text (lines str'))
-blockToRST HorizontalRule = return $ text "--------------\n"
+ contents <- inlineListToRST inlines
+ return $ contents <> blankline
+blockToRST (RawBlock f str) =
+ return $ blankline <> ".. raw:: " <> text f $+$
+ (nest 3 $ text str) $$ blankline
+blockToRST HorizontalRule =
+ return $ blankline $$ "--------------" $$ blankline
blockToRST (Header level inlines) = do
contents <- inlineListToRST inlines
- let headerLength = length $ render contents
let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
- let border = text $ replicate headerLength headerChar
- return $ contents $+$ border <> text "\n"
+ let border = text $ replicate (offset contents) headerChar
+ return $ contents $$ border $$ blankline
blockToRST (CodeBlock (_,classes,_) str) = do
opts <- stOptions <$> get
let tabstop = writerTabStop opts
if "haskell" `elem` classes && "literate" `elem` classes &&
writerLiterateHaskell opts
- then return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
- else return $ (text "::\n") $+$
- (nest tabstop $ vcat $ map text (lines str)) <> text "\n"
+ then return $ prefixed "> " (text str) $$ blankline
+ else return $ "::" $+$ nest tabstop (text str) $$ blankline
blockToRST (BlockQuote blocks) = do
tabstop <- get >>= (return . writerTabStop . stOptions)
contents <- blockListToRST blocks
- return $ (nest tabstop contents) <> text "\n"
+ return $ (nest tabstop contents) <> blankline
blockToRST (Table caption _ widths headers rows) = do
caption' <- inlineListToRST caption
let caption'' = if null caption
then empty
- else text "" $+$ (text "Table: " <> caption')
+ else blankline <> text "Table: " <> caption'
headers' <- mapM blockListToRST headers
rawRows <- mapM (mapM blockListToRST) rows
let isSimple = all (==0) widths && all (all (\bs -> length bs == 1)) rows
- let numChars = maximum . map (length . render)
+ let numChars = maximum . map offset
+ opts <- get >>= return . stOptions
let widthsInChars =
if isSimple
then map ((+2) . numChars) $ transpose (headers' : rawRows)
- else map (floor . (78 *)) widths
- let hpipeBlocks blocks = hcatBlocks [beg, middle, end]
- where height = maximum (map heightOfBlock blocks)
- sep' = TextBlock 3 height (replicate height " | ")
- beg = TextBlock 2 height (replicate height "| ")
- end = TextBlock 2 height (replicate height " |")
- middle = hcatBlocks $ intersperse sep' blocks
- let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars
+ else map (floor . (fromIntegral (writerColumns opts) *)) widths
+ let hpipeBlocks blocks = hcat [beg, middle, end]
+ where h = maximum (map height blocks)
+ sep' = lblock 3 $ vcat (map text $ replicate h " | ")
+ beg = lblock 2 $ vcat (map text $ replicate h "| ")
+ end = lblock 2 $ vcat (map text $ replicate h " |")
+ middle = hcat $ intersperse sep' blocks
+ let makeRow = hpipeBlocks . zipWith lblock widthsInChars
let head' = makeRow headers'
rows' <- mapM (\row -> do cols <- mapM blockListToRST row
return $ makeRow cols) rows
@@ -206,15 +197,15 @@ blockToRST (Table caption _ widths headers rows) = do
(hcat $ intersperse (char ch <> char '+' <> char ch) $
map (\l -> text $ replicate l ch) widthsInChars) <>
char ch <> char '+'
- let body = vcat $ intersperse (border '-') $ map blockToDoc rows'
+ let body = vcat $ intersperse (border '-') rows'
let head'' = if all null headers
then empty
- else blockToDoc head' $+$ border '='
- return $ border '-' $+$ head'' $+$ body $+$ border '-' $$ caption'' $$ text ""
+ else head' $$ border '='
+ return $ border '-' $$ head'' $$ body $$ border '-' $$ caption'' $$ blankline
blockToRST (BulletList items) = do
contents <- mapM bulletListItemToRST items
-- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
+ return $ blankline $$ vcat contents $$ blankline
blockToRST (OrderedList (start, style', delim) items) = do
let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim
then take (length items) $ repeat "#."
@@ -224,18 +215,19 @@ blockToRST (OrderedList (start, style', delim) items) = do
let markers' = map (\m -> let s = maxMarkerLength - length m
in m ++ replicate s ' ') markers
contents <- mapM (\(item, num) -> orderedListItemToRST item num) $
- zip markers' items
+ zip markers' items
-- ensure that sublists have preceding blank line
- return $ text "" $+$ vcat contents <> text "\n"
+ return $ blankline $$ vcat contents $$ blankline
blockToRST (DefinitionList items) = do
contents <- mapM definitionListItemToRST items
- return $ (vcat contents) <> text "\n"
+ -- ensure that sublists have preceding blank line
+ return $ blankline $$ vcat contents $$ blankline
-- | Convert bullet list item (list of blocks) to RST.
bulletListItemToRST :: [Block] -> State WriterState Doc
bulletListItemToRST items = do
contents <- blockListToRST items
- return $ (text "- ") <> contents
+ return $ hang 3 "- " $ contents <> cr
-- | Convert ordered list item (a list of blocks) to RST.
orderedListItemToRST :: String -- ^ marker for list item
@@ -243,7 +235,8 @@ orderedListItemToRST :: String -- ^ marker for list item
-> State WriterState Doc
orderedListItemToRST marker items = do
contents <- blockListToRST items
- return $ (text marker <> char ' ') <> contents
+ let marker' = marker ++ " "
+ return $ hang (length marker') (text marker') $ contents <> cr
-- | Convert defintion list item (label, list of blocks) to RST.
definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc
@@ -251,7 +244,7 @@ definitionListItemToRST (label, defs) = do
label' <- inlineListToRST label
contents <- liftM vcat $ mapM blockListToRST defs
tabstop <- get >>= (return . writerTabStop . stOptions)
- return $ label' $+$ nest tabstop contents
+ return $ label' $$ nest tabstop (contents <> cr)
-- | Convert list of Pandoc block elements to RST.
blockListToRST :: [Block] -- ^ List of block elements
@@ -266,65 +259,63 @@ inlineListToRST lst = mapM inlineToRST lst >>= return . hcat
inlineToRST :: Inline -> State WriterState Doc
inlineToRST (Emph lst) = do
contents <- inlineListToRST lst
- return $ char '*' <> contents <> char '*'
+ return $ "*" <> contents <> "*"
inlineToRST (Strong lst) = do
contents <- inlineListToRST lst
- return $ text "**" <> contents <> text "**"
+ return $ "**" <> contents <> "**"
inlineToRST (Strikeout lst) = do
contents <- inlineListToRST lst
- return $ text "[STRIKEOUT:" <> contents <> char ']'
+ return $ "[STRIKEOUT:" <> contents <> "]"
inlineToRST (Superscript lst) = do
contents <- inlineListToRST lst
- return $ text "\\ :sup:`" <> contents <> text "`\\ "
+ return $ "\\ :sup:`" <> contents <> "`\\ "
inlineToRST (Subscript lst) = do
contents <- inlineListToRST lst
- return $ text "\\ :sub:`" <> contents <> text "`\\ "
+ return $ "\\ :sub:`" <> contents <> "`\\ "
inlineToRST (SmallCaps lst) = inlineListToRST lst
inlineToRST (Quoted SingleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '‘' <> contents <> char '’'
+ return $ "‘" <> contents <> "’"
inlineToRST (Quoted DoubleQuote lst) = do
contents <- inlineListToRST lst
- return $ char '“' <> contents <> char '”'
+ return $ "“" <> contents <> "”"
inlineToRST (Cite _ lst) =
inlineListToRST lst
inlineToRST EmDash = return $ char '\8212'
inlineToRST EnDash = return $ char '\8211'
inlineToRST Apostrophe = return $ char '\8217'
inlineToRST Ellipses = return $ char '\8230'
-inlineToRST (Code str) = return $ text $ "``" ++ str ++ "``"
+inlineToRST (Code _ str) = return $ "``" <> text str <> "``"
inlineToRST (Str str) = return $ text $ escapeString str
inlineToRST (Math t str) = do
modify $ \st -> st{ stHasMath = True }
return $ if t == InlineMath
- then text $ ":math:`$" ++ str ++ "$`"
- else text $ ":math:`$$" ++ str ++ "$$`"
-inlineToRST (TeX _) = return empty
-inlineToRST (HtmlInline _) = return empty
-inlineToRST (LineBreak) = do
- return $ empty -- there's no line break in RST
-inlineToRST Space = return $ char ' '
-inlineToRST (Link [Code str] (src, _)) | src == str ||
- src == "mailto:" ++ str = do
+ then ":math:`$" <> text str <> "$`"
+ else ":math:`$$" <> text str <> "$$`"
+inlineToRST (RawInline _ _) = return empty
+inlineToRST (LineBreak) = return cr -- there's no line break in RST
+inlineToRST Space = return space
+inlineToRST (Link [Code _ str] (src, _)) | src == str ||
+ src == "mailto:" ++ str = do
let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
return $ text $ unescapeURI srcSuffix
inlineToRST (Link txt (src', tit)) = do
let src = unescapeURI src'
- useReferenceLinks <- get >>= (return . writerReferenceLinks . stOptions)
+ useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions
linktext <- inlineListToRST $ normalizeSpaces txt
if useReferenceLinks
- then do refs <- get >>= (return . stLinks)
+ then do refs <- get >>= return . stLinks
let refs' = if (txt, (src, tit)) `elem` refs
then refs
else (txt, (src, tit)):refs
modify $ \st -> st { stLinks = refs' }
- return $ char '`' <> linktext <> text "`_"
- else return $ char '`' <> linktext <> text " <" <> text src <> text ">`_"
+ return $ "`" <> linktext <> "`_"
+ else return $ "`" <> linktext <> " <" <> text src <> ">`_"
inlineToRST (Image alternate (source', tit)) = do
let source = unescapeURI source'
- pics <- get >>= (return . stImages)
+ pics <- get >>= return . stImages
let labelsUsed = map fst pics
- let txt = if null alternate || alternate == [Str ""] ||
+ let txt = if null alternate || alternate == [Str ""] ||
alternate `elem` labelsUsed
then [Str $ "image" ++ show (length pics)]
else alternate
@@ -333,10 +324,10 @@ inlineToRST (Image alternate (source', tit)) = do
else (txt, (source, tit)):pics
modify $ \st -> st { stImages = pics' }
label <- inlineListToRST txt
- return $ char '|' <> label <> char '|'
+ return $ "|" <> label <> "|"
inlineToRST (Note contents) = do
-- add to notes in state
- notes <- get >>= (return . stNotes)
+ notes <- get >>= return . stNotes
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ (length notes) + 1
- return $ text " [" <> text ref <> text "]_"
+ return $ " [" <> text ref <> "]_"
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-25 01:59:11 +0000