From 29c2670da2a267094148f3edacaed5fc258bcdd1 Mon Sep 17 00:00:00 2001
From: Lucas Escot <flupe@users.noreply.github.com>
Date: Thu, 13 Feb 2020 19:27:34 +0100
Subject: [PATCH] Add highlight directive to the rST reader (#6140)
---
src/Text/Pandoc/Parsing.hs | 2 ++
src/Text/Pandoc/Readers/RST.hs | 15 +++++++++++----
test/rst-reader.native | 4 ++++
test/rst-reader.rst | 24 ++++++++++++++++++++++++
4 files changed, 41 insertions(+), 4 deletions(-)
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 57b780e7f..87b391eda 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -1138,6 +1138,7 @@ data ParserState = ParserState
stateExamples :: M.Map Text Int, -- ^ Map from example labels to numbers
stateMacros :: M.Map Text Macro, -- ^ Table of macros defined so far
stateRstDefaultRole :: Text, -- ^ Current rST default interpreted text role
+ stateRstHighlight :: Maybe Text, -- ^ Current rST literal block language
stateRstCustomRoles :: M.Map Text (Text, Maybe Text, Attr), -- ^ Current rST custom text roles
-- Triple represents: 1) Base role, 2) Optional format (only for :raw:
-- roles), 3) Additional classes (rest of Attr is unused)).
@@ -1248,6 +1249,7 @@ defaultParserState =
stateExamples = M.empty,
stateMacros = M.empty,
stateRstDefaultRole = "title-reference",
+ stateRstHighlight = Nothing,
stateRstCustomRoles = M.empty,
stateCaption = Nothing,
stateInHtmlBlock = Nothing,
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index ba1902a6e..e6e6d56e8 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -23,7 +23,7 @@ import Control.Monad.Identity (Identity (..))
import Data.Char (isHexDigit, isSpace, toUpper, isAlphaNum)
import Data.List (deleteFirstsBy, elemIndex, nub, sort, transpose)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, maybeToList)
import Data.Sequence (ViewR (..), viewr)
import Data.Text (Text)
import qualified Data.Text as T
@@ -390,11 +390,13 @@ quotedBlock = try $ do
codeBlockStart :: Monad m => ParserT Text st m Char
codeBlockStart = string "::" >> blankline >> blankline
-codeBlock :: (HasReaderOptions st, Monad m) => ParserT Text st m Blocks
+codeBlock :: Monad m => ParserT Text ParserState m Blocks
codeBlock = try $ codeBlockStart >> codeBlockBody
-codeBlockBody :: (HasReaderOptions st, Monad m) => ParserT Text st m Blocks
-codeBlockBody = try $ B.codeBlock . stripTrailingNewlines <$>
+codeBlockBody :: Monad m => ParserT Text ParserState m Blocks
+codeBlockBody = do
+ lang <- stateRstHighlight <$> getState
+ try $ B.codeBlockWith ("", maybeToList lang, []) . stripTrailingNewlines <$>
(indentedBlock <|> quotedBlock)
lhsCodeBlock :: Monad m => RSTParser m Blocks
@@ -716,6 +718,11 @@ directive' = do
case trim top of
"" -> stateRstDefaultRole def
role -> role })
+ "highlight" -> mempty <$ updateState (\s ->
+ s { stateRstHighlight =
+ case trim top of
+ "" -> stateRstHighlight def
+ lang -> Just lang })
x | x == "code" || x == "code-block" || x == "sourcecode" ->
codeblock name classes
(lookup "number-lines" fields) (trim top) body True
diff --git a/test/rst-reader.native b/test/rst-reader.native
index 70ed3cf60..d4322f9ae 100644
--- a/test/rst-reader.native
+++ b/test/rst-reader.native
@@ -39,6 +39,10 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,CodeBlock ("",[],[]) "this block is indented by two tabs\n\nThese should not be escaped: \\$ \\\\ \\> \\[ \\{"
,Para [Str "And:"]
,CodeBlock ("",["python"],[]) "def my_function(x):\n return x + 1"
+,Para [Str "If",Space,Str "we",Space,Str "use",Space,Str "the",Space,Str "highlight",Space,Str "directive,",Space,Str "we",Space,Str "can",Space,Str "specify",Space,Str "a",Space,Str "default",Space,Str "language",SoftBreak,Str "for",Space,Str "literate",Space,Str "blocks."]
+,CodeBlock ("",["haskell"],[]) "-- this code is in haskell\ndata Tree = Leaf | Node Tree Tree"
+,CodeBlock ("",["haskell"],[]) "-- this code is in haskell too\ndata Nat = Zero | Succ Nat"
+,CodeBlock ("",["javascript"],[]) "-- this code is in javascript\nlet f = (x, y) => x + y"
,Header 1 ("lists",[],[]) [Str "Lists"]
,Header 2 ("unordered",[],[]) [Str "Unordered"]
,Para [Str "Asterisks",Space,Str "tight:"]
diff --git a/test/rst-reader.rst b/test/rst-reader.rst
index a918c0e2c..d2d82d435 100644
--- a/test/rst-reader.rst
+++ b/test/rst-reader.rst
@@ -107,6 +107,30 @@ And:
def my_function(x):
return x + 1
+If we use the highlight directive, we can specify a default language
+for literate blocks.
+
+.. highlight:: haskell
+
+::
+
+ -- this code is in haskell
+ data Tree = Leaf | Node Tree Tree
+
+::
+
+ -- this code is in haskell too
+ data Nat = Zero | Succ Nat
+
+.. highlight:: javascript
+
+::
+
+ -- this code is in javascript
+ let f = (x, y) => x + y
+
+.. highlight::
+
Lists
=====