Add highlight directive to the rST reader (#6140)

2 files changed, 13 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