diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/RST.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 170 |
1 files changed, 81 insertions, 89 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index e79f97b33..908549041 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 (RawHtml str) = + return $ blankline <> ".. raw:: html" $+$ + (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,64 @@ 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 ++ "$$`" + then ":math:`$" <> text str <> "$`" + else ":math:`$$" <> text 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 (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 +325,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 <> "]_" |