git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #2079 from lierdakil/rst-normalize-headings

RST Writer: Normalize headings to sequential levels

commit44fcc5f96e3f412337a98a1791a79b059579f78e authorJohn MacFarlane <jgm@berkeley.edu> dateFri 17 Apr 2015, 19:06 (12 years ago) parent96abd904b7ddeb
4 files changed+118−7
pandoc.cabal+1 src/Text/Pandoc/Writers/RST.hs+36−7 tests/Tests/Writers/RST.hs+79 tests/test-pandoc.hs+2
pandoc.cabal+1
@@ -495,6 +495,7 @@ Test-Suite test-pandoc
495495 Tests.Writers.AsciiDoc
496496 Tests.Writers.LaTeX
497497 Tests.Writers.Docx
498+ Tests.Writers.RST
498499 Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind -threaded
499500 Default-Language: Haskell98
500501
src/Text/Pandoc/Writers/RST.hs+36−7
@@ -54,6 +54,7 @@ data WriterState =
5454 , stHasMath :: Bool
5555 , stHasRawTeX :: Bool
5656 , stOptions :: WriterOptions
57+ , stTopLevel :: Bool
5758 }
5859
5960-- | Convert Pandoc to RST.
@@ -61,7 +62,8 @@ writeRST :: WriterOptions -> Pandoc -> String
6162writeRST opts document =
6263 let st = WriterState { stNotes = [], stLinks = [],
6364 stImages = [], stHasMath = False,
64− stHasRawTeX = False, stOptions = opts }
65+ stHasRawTeX = False, stOptions = opts,
66+ stTopLevel = True}
6567 in evalState (pandocToRST document) st
6668
6769-- | Return RST representation of document.
@@ -79,7 +81,7 @@ pandocToRST (Pandoc meta blocks) = do
7981 (fmap (render colwidth) . blockListToRST)
8082 (fmap (trimr . render colwidth) . inlineListToRST)
8183 $ deleteMeta "title" $ deleteMeta "subtitle" meta
82− body <- blockListToRST blocks
84+ body <- blockListToRST' True $ normalizeHeadings 1 blocks
8385 notes <- liftM (reverse . stNotes) get >>= notesToRST
8486 -- note that the notes may contain refs, so we do them first
8587 refs <- liftM (reverse . stLinks) get >>= refsToRST
@@ -98,6 +100,13 @@ pandocToRST (Pandoc meta blocks) = do
98100 if writerStandalone opts
99101 then return $ renderTemplate' (writerTemplate opts) context
100102 else return main
103+ where
104+ normalizeHeadings lev (Header l a i:bs) = Header lev a i:normalizeHeadings (lev+1) cont ++ normalizeHeadings lev bs'
105+ where (cont,bs') = break (headerLtEq l) bs
106+ headerLtEq level (Header l' _ _) = l' <= level
107+ headerLtEq _ _ = False
108+ normalizeHeadings lev (b:bs) = b:normalizeHeadings lev bs
109+ normalizeHeadings _ [] = []
101110
102111-- | Return RST representation of reference key table.
103112refsToRST :: Refs -> State WriterState Doc
@@ -191,11 +200,21 @@ blockToRST (RawBlock f@(Format f') str)
191200 (nest 3 $ text str) $$ blankline
192201blockToRST HorizontalRule =
193202 return $ blankline $$ "--------------" $$ blankline
194−blockToRST (Header level _ inlines) = do
203+blockToRST (Header level (name,classes,_) inlines) = do
195204 contents <- inlineListToRST inlines
196− let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
197− let border = text $ replicate (offset contents) headerChar
198− return $ nowrap $ contents $$ border $$ blankline
205+ isTopLevel <- gets stTopLevel
206+ if isTopLevel
207+ then do
208+ let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
209+ let border = text $ replicate (offset contents) headerChar
210+ return $ nowrap $ contents $$ border $$ blankline
211+ else do
212+ let rub = "rubric:: " <> contents
213+ let name' | null name = empty
214+ | otherwise = ":name: " <> text name
215+ let cls | null classes = empty
216+ | otherwise = ":class: " <> text (unwords classes)
217+ return $ nowrap $ hang 3 ".. " (rub $$ name' $$ cls) $$ blankline
199218blockToRST (CodeBlock (_,classes,kvs) str) = do
200219 opts <- stOptions <$> get
201220 let tabstop = writerTabStop opts
@@ -297,9 +316,19 @@ definitionListItemToRST (label, defs) = do
297316 return $ label' $$ nest tabstop (nestle contents <> cr)
298317
299318-- | Convert list of Pandoc block elements to RST.
319+blockListToRST' :: Bool
320+ -> [Block] -- ^ List of block elements
321+ -> State WriterState Doc
322+blockListToRST' topLevel blocks = do
323+ tl <- gets stTopLevel
324+ modify (\s->s{stTopLevel=topLevel})
325+ res <- vcat `fmap` mapM blockToRST blocks
326+ modify (\s->s{stTopLevel=tl})
327+ return res
328+
300329blockListToRST :: [Block] -- ^ List of block elements
301330 -> State WriterState Doc
302−blockListToRST blocks = mapM blockToRST blocks >>= return . vcat
331+blockListToRST = blockListToRST' False
303332
304333-- | Convert list of Pandoc inline elements to RST.
305334inlineListToRST :: [Inline] -> State WriterState Doc
tests/Tests/Writers/RST.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Tests.Writers.RST (tests) where
3+
4+import Test.Framework
5+import Text.Pandoc.Builder
6+import Text.Pandoc
7+import Tests.Helpers
8+import Tests.Arbitrary()
9+
10+infix 4 =:
11+(=:) :: (ToString a, ToPandoc a)
12+ => String -> (a, String) -> Test
13+(=:) = test (writeRST def{ writerHighlight = True } . toPandoc)
14+
15+tests :: [Test]
16+tests = [ testGroup "rubrics"
17+ [ "in list item" =:
18+ bulletList [header 2 (text "foo")] =?>
19+ "- .. rubric:: foo"
20+ , "in definition list item" =:
21+ definitionList [(text "foo", [header 2 (text "bar"),
22+ para $ text "baz"])] =?>
23+ unlines
24+ [ "foo"
25+ , " .. rubric:: bar"
26+ , ""
27+ , " baz"]
28+ , "in block quote" =:
29+ blockQuote (header 1 (text "bar")) =?>
30+ " .. rubric:: bar"
31+ , "with id" =:
32+ blockQuote (headerWith ("foo",[],[]) 1 (text "bar")) =?>
33+ unlines
34+ [ " .. rubric:: bar"
35+ , " :name: foo"]
36+ , "with id class" =:
37+ blockQuote (headerWith ("foo",["baz"],[]) 1 (text "bar")) =?>
38+ unlines
39+ [ " .. rubric:: bar"
40+ , " :name: foo"
41+ , " :class: baz"]
42+ ]
43+ , testGroup "headings"
44+ [ "normal heading" =:
45+ header 1 (text "foo") =?>
46+ unlines
47+ [ "foo"
48+ , "==="]
49+ , "heading levels" =:
50+ header 1 (text "Header 1") <>
51+ header 3 (text "Header 2") <>
52+ header 2 (text "Header 2") <>
53+ header 1 (text "Header 1") <>
54+ header 4 (text "Header 2") <>
55+ header 5 (text "Header 3") <>
56+ header 3 (text "Header 2") =?>
57+ unlines
58+ [ "Header 1"
59+ , "========"
60+ , ""
61+ , "Header 2"
62+ , "--------"
63+ , ""
64+ , "Header 2"
65+ , "--------"
66+ , ""
67+ , "Header 1"
68+ , "========"
69+ , ""
70+ , "Header 2"
71+ , "--------"
72+ , ""
73+ , "Header 3"
74+ , "~~~~~~~~"
75+ , ""
76+ , "Header 2"
77+ , "--------"]
78+ ]
79+ ]
tests/test-pandoc.hs+2
@@ -21,6 +21,7 @@ import qualified Tests.Writers.Markdown
2121import qualified Tests.Writers.Plain
2222import qualified Tests.Writers.AsciiDoc
2323import qualified Tests.Writers.Docx
24+import qualified Tests.Writers.RST
2425import qualified Tests.Shared
2526import qualified Tests.Walk
2627import Text.Pandoc.Shared (inDirectory)
@@ -40,6 +41,7 @@ tests = [ testGroup "Old" Tests.Old.tests
4041 , testGroup "Plain" Tests.Writers.Plain.tests
4142 , testGroup "AsciiDoc" Tests.Writers.AsciiDoc.tests
4243 , testGroup "Docx" Tests.Writers.Docx.tests
44+ , testGroup "RST" Tests.Writers.RST.tests
4345 ]
4446 , testGroup "Readers"
4547 [ testGroup "LaTeX" Tests.Readers.LaTeX.tests