1 files changed, 188 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
new file mode 100644
index 000000000..37d895336
--- /dev/null
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -0,0 +1,188 @@
+-- | Converts Pandoc to reStructuredText.
+module Text.Pandoc.Writers.RST (
+                                writeRST 
+                               ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared
+import List ( nubBy )
+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)) 
+                       (reformatBlocks $ replaceReferenceLinks blocks) 
+        top = if (writerStandalone options) then 
+                  (metaToRST meta) $$ text (writerHeader options) 
+              else 
+                  empty in 
+    let refs' = nubBy (\x y -> (render x) == (render y)) refs in -- remove duplicate keys
+    let body = text (writerIncludeBefore options) <> 
+               vcat main $$ text (writerIncludeAfter options) in
+    render $ top <> body $$ vcat refs'
+
+-- | Escape special RST characters.
+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 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 ((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 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)
+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")))), 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)
+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)
+
+-- | 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 (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 [])) = 
+    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)
+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)
+inlineToRST (Image alternate (Ref [])) = 
+    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)