diff options
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 43 | ||||
| -rw-r--r-- | tests/Tests/Writers/RST.hs | 79 | ||||
| -rw-r--r-- | tests/test-pandoc.hs | 2 |
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 |