Merge pull request #2079 from lierdakil/rst-normalize-headings

RST Writer: Normalize headings to sequential levels

4 files changed, 118 insertions, 7 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index f52fdd73c..2e04f6bc7 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -495,6 +495,7 @@ Test-Suite test-pandoc
                   Tests.Writers.AsciiDoc
                   Tests.Writers.LaTeX
                   Tests.Writers.Docx
+                  Tests.Writers.RST
   Ghc-Options:  -rtsopts -Wall -fno-warn-unused-do-bind -threaded
   Default-Language: Haskell98
 
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 2f4c9575e..2dd899680 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -54,6 +54,7 @@ data WriterState =
               , stHasMath     :: Bool
               , stHasRawTeX   :: Bool
               , stOptions     :: WriterOptions
+              , stTopLevel    :: Bool
               }
 
 -- | Convert Pandoc to RST.
@@ -61,7 +62,8 @@ writeRST :: WriterOptions -> Pandoc -> String
 writeRST opts document =
   let st = WriterState { stNotes = [], stLinks = [],
                          stImages = [], stHasMath = False,
-                         stHasRawTeX = False, stOptions = opts }
+                         stHasRawTeX = False, stOptions = opts,
+                         stTopLevel = True}
   in evalState (pandocToRST document) st
 
 -- | Return RST representation of document.
@@ -79,7 +81,7 @@ pandocToRST (Pandoc meta blocks) = do
                 (fmap (render colwidth) . blockListToRST)
                 (fmap (trimr . render colwidth) . inlineListToRST)
                 $ deleteMeta "title" $ deleteMeta "subtitle" meta
-  body <- blockListToRST blocks
+  body <- blockListToRST' True $ normalizeHeadings 1 blocks
   notes <- liftM (reverse . stNotes) get >>= notesToRST
   -- note that the notes may contain refs, so we do them first
   refs <- liftM (reverse . stLinks) get >>= refsToRST
@@ -98,6 +100,13 @@ pandocToRST (Pandoc meta blocks) = do
   if writerStandalone opts
      then return $ renderTemplate' (writerTemplate opts) context
      else return main
+  where
+    normalizeHeadings lev (Header l a i:bs) = Header lev a i:normalizeHeadings (lev+1) cont ++ normalizeHeadings lev bs'
+      where (cont,bs') = break (headerLtEq l) bs
+            headerLtEq level (Header l' _ _) = l' <= level
+            headerLtEq _ _ = False
+    normalizeHeadings lev (b:bs) = b:normalizeHeadings lev bs
+    normalizeHeadings _   []     = []
 
 -- | Return RST representation of reference key table.
 refsToRST :: Refs -> State WriterState Doc
@@ -191,11 +200,21 @@ blockToRST (RawBlock f@(Format f') str)
                     (nest 3 $ text str) $$ blankline
 blockToRST HorizontalRule =
   return $ blankline $$ "--------------" $$ blankline
-blockToRST (Header level _ inlines) = do
+blockToRST (Header level (name,classes,_) inlines) = do
   contents <- inlineListToRST inlines
-  let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
-  let border = text $ replicate (offset contents) headerChar
-  return $ nowrap $ contents $$ border $$ blankline
+  isTopLevel <- gets stTopLevel
+  if isTopLevel
+    then do
+          let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
+          let border = text $ replicate (offset contents) headerChar
+          return $ nowrap $ contents $$ border $$ blankline
+    else do
+          let rub     = "rubric:: " <> contents
+          let name' | null name    = empty
+                    | otherwise    = ":name: " <> text name
+          let cls   | null classes = empty
+                    | otherwise    = ":class: " <> text (unwords classes)
+          return $ nowrap $ hang 3 ".. " (rub $$ name' $$ cls) $$ blankline
 blockToRST (CodeBlock (_,classes,kvs) str) = do
   opts <- stOptions <$> get
   let tabstop = writerTabStop opts
@@ -297,9 +316,19 @@ definitionListItemToRST (label, defs) = do
   return $ label' $$ nest tabstop (nestle contents <> cr)
 
 -- | Convert list of Pandoc block elements to RST.
+blockListToRST' :: Bool
+                -> [Block]       -- ^ List of block elements
+                -> State WriterState Doc
+blockListToRST' topLevel blocks = do
+  tl <- gets stTopLevel
+  modify (\s->s{stTopLevel=topLevel})
+  res <- vcat `fmap` mapM blockToRST blocks
+  modify (\s->s{stTopLevel=tl})
+  return res
+
 blockListToRST :: [Block]       -- ^ List of block elements
                -> State WriterState Doc
-blockListToRST blocks = mapM blockToRST blocks >>= return . vcat
+blockListToRST = blockListToRST' False
 
 -- | Convert list of Pandoc inline elements to RST.
 inlineListToRST :: [Inline] -> State WriterState Doc
diff --git a/tests/Tests/Writers/RST.hs b/tests/Tests/Writers/RST.hs
new file mode 100644
index 000000000..2a511782f
--- /dev/null
+++ b/tests/Tests/Writers/RST.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Writers.RST (tests) where
+
+import Test.Framework
+import Text.Pandoc.Builder
+import Text.Pandoc
+import Tests.Helpers
+import Tests.Arbitrary()
+
+infix 4 =:
+(=:) :: (ToString a, ToPandoc a)
+     => String -> (a, String) -> Test
+(=:) = test (writeRST def{ writerHighlight = True } . toPandoc)
+
+tests :: [Test]
+tests = [ testGroup "rubrics"
+          [ "in list item" =:
+              bulletList [header 2 (text "foo")] =?>
+              "-  .. rubric:: foo"
+          , "in definition list item" =:
+              definitionList [(text "foo", [header 2 (text "bar"),
+                                            para $ text "baz"])] =?>
+              unlines
+              [ "foo"
+              , "    .. rubric:: bar"
+              , ""
+              , "    baz"]
+          , "in block quote" =:
+              blockQuote (header 1 (text "bar")) =?>
+              "    .. rubric:: bar"
+          , "with id" =:
+              blockQuote (headerWith ("foo",[],[]) 1 (text "bar")) =?>
+              unlines
+              [ "    .. rubric:: bar"
+              , "       :name: foo"]
+          , "with id class" =:
+              blockQuote (headerWith ("foo",["baz"],[]) 1 (text "bar")) =?>
+              unlines
+              [ "    .. rubric:: bar"
+              , "       :name: foo"
+              , "       :class: baz"]
+          ]
+        , testGroup "headings"
+          [ "normal heading" =:
+              header 1 (text "foo") =?>
+              unlines
+              [ "foo"
+              , "==="]
+          , "heading levels" =:
+              header 1 (text "Header 1") <>
+              header 3 (text "Header 2") <>
+              header 2 (text "Header 2") <>
+              header 1 (text "Header 1") <>
+              header 4 (text "Header 2") <>
+              header 5 (text "Header 3") <>
+              header 3 (text "Header 2") =?>
+              unlines
+              [ "Header 1"
+              , "========"
+              , ""
+              , "Header 2"
+              , "--------"
+              , ""
+              , "Header 2"
+              , "--------"
+              , ""
+              , "Header 1"
+              , "========"
+              , ""
+              , "Header 2"
+              , "--------"
+              , ""
+              , "Header 3"
+              , "~~~~~~~~"
+              , ""
+              , "Header 2"
+              , "--------"]
+          ]
+        ]
diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs
index dd92a271a..805bad414 100644
--- a/tests/test-pandoc.hs
+++ b/tests/test-pandoc.hs
@@ -21,6 +21,7 @@ import qualified Tests.Writers.Markdown
 import qualified Tests.Writers.Plain
 import qualified Tests.Writers.AsciiDoc
 import qualified Tests.Writers.Docx
+import qualified Tests.Writers.RST
 import qualified Tests.Shared
 import qualified Tests.Walk
 import Text.Pandoc.Shared (inDirectory)
@@ -40,6 +41,7 @@ tests = [ testGroup "Old" Tests.Old.tests
           , testGroup "Plain" Tests.Writers.Plain.tests
           , testGroup "AsciiDoc" Tests.Writers.AsciiDoc.tests
           , testGroup "Docx" Tests.Writers.Docx.tests
+          , testGroup "RST" Tests.Writers.RST.tests
           ]
         , testGroup "Readers"
           [ testGroup "LaTeX" Tests.Readers.LaTeX.tests