RST Reader: compute Attrs when role is defined

Move recursive role lookup from renderRole to addNewRole.  The Attr value
will be the same for every occurance of this role, so there's no reason
to compute it every time.  This allows simplifying the
stateRstCustomRoles map considerably.

We could go even further, and remove the fmt and attr arguments to
renderRole, which are null except for custom roles.

src/Text/Pandoc/Parsing.hs

@@ -921,10 +921,9 @@ data ParserState = ParserState
       stateHasChapters     :: Bool,          -- ^ True if \chapter encountered
       stateMacros          :: [Macro],       -- ^ List of macros defined so far
       stateRstDefaultRole  :: String,        -- ^ Current rST default interpreted text role
-      stateRstCustomRoles  :: M.Map String (String, Maybe String, Attr -> (String, Attr)), -- ^ Current rST custom text roles
+      stateRstCustomRoles  :: M.Map String (String, Maybe String, Attr), -- ^ Current rST custom text roles
       -- Triple represents: 1) Base role, 2) Optional format (only for :raw:
-      -- roles), 3) Source language annotation for code (could be used to
-      -- annotate role classes too).
+      -- roles), 3) Additional classes (rest of Attr is unused)).
       stateCaption         :: Maybe Inlines, -- ^ Caption in current environment
       stateInHtmlBlock     :: Maybe String,  -- ^ Tag type of HTML block being parsed
       stateMarkdownAttribute :: Bool,        -- ^ True if in markdown=1 context

src/Text/Pandoc/Readers/RST.hs

@@ -625,25 +625,27 @@ addNewRole :: String -> [(String, String)] -> RSTParser Blocks
 addNewRole roleString fields = do
     (role, parentRole) <- parseFromString inheritedRole roleString
     customRoles <- stateRstCustomRoles <$> getState
-    baseRole <- case M.lookup parentRole customRoles of
-        Just (base, _, _) -> return base
-        Nothing -> return parentRole
+    let (baseRole, baseFmt, baseAttr) =
+            maybe (parentRole, Nothing, nullAttr) id $
+              M.lookup parentRole customRoles
 
-    let fmt = if baseRole == "raw" then lookup "format" fields else Nothing
-        annotate = maybe (addClass role) (addLanguage role) $
+    let fmt = if parentRole == "raw" then lookup "format" fields else baseFmt
+        -- nub in case role name & language class are the same
+        annotate :: [String] -> [String]
+        annotate = maybe id (:) $
             if baseRole == "code"
                then lookup "language" fields
                else Nothing
+        attr = let (ident, classes, keyValues) = baseAttr
+               in (ident, nub . (role :) . annotate $ classes, keyValues)
 
     updateState $ \s -> s {
         stateRstCustomRoles =
-          M.insert role (baseRole, fmt, (,) parentRole . annotate) customRoles
+          M.insert role (baseRole, fmt, attr) customRoles
     }
 
     return $ B.singleton Null
   where
-    addLanguage role lang (ident, classes, keyValues) =
-        (ident, nub ("sourceCode" : lang : role : classes), keyValues)
     inheritedRole =
         (,) <$> roleName <*> ((char '(' *> roleName <* char ')') <|> pure "span")
 
@@ -1014,12 +1016,10 @@ renderRole contents fmt role attr = case role of
     "span" -> return $ B.spanWith attr $ B.str contents
     "raw" -> return $ B.rawInline (fromMaybe "" fmt) contents
     custom -> do
-        customRole <- stateRstCustomRoles <$> getState
-        case M.lookup custom customRole of
-            Just (_, newFmt, inherit) -> let
-                fmtStr = fmt `mplus` newFmt
-                (newRole, newAttr) = inherit attr
-                in renderRole contents fmtStr newRole newAttr
+        customRoles <- stateRstCustomRoles <$> getState
+        case M.lookup custom customRoles of
+            Just (newRole, newFmt, newAttr) ->
+                renderRole contents newFmt newRole newAttr
             Nothing -> do
                 pos <- getPosition
                 addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in "

tests/Tests/Readers/RST.hs

@@ -99,7 +99,7 @@ tests = [ "line block with blank line" =:
             =?> para (codeWith ("", ["codeLike", "sourceCode"], []) "a")
           , "custom code role with language field"
             =: ".. role:: lhs(code)\n    :language: haskell\n\n:lhs:`a`"
-            =?> para (codeWith ("", ["sourceCode", "haskell", "lhs"], []) "a")
+            =?> para (codeWith ("", ["lhs", "haskell","sourceCode"], []) "a")
           , "custom role with unspecified parent role"
             =: ".. role:: classy\n\n:classy:`text`"
             =?> para (spanWith ("", ["classy"], []) "text")

tests/rst-reader.native

@@ -322,12 +322,12 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
 ,Null
 ,Para [Str "And",Space,Str "now",Space,Str "with",Space,RawInline (Format "html") "<b>inline</b> <span id=\"test\">HTML</span>",Str "."]
 ,Null
-,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["sourceCode","haskell"],[]) "fmap id [1,2..10]",Str "."]
+,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["haskell","sourceCode"],[]) "fmap id [1,2..10]",Str "."]
 ,Null
 ,Null
-,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["sourceCode","python","indirect"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]
+,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["python","indirect","sourceCode"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]
 ,Null
 ,Null
-,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["sourceCode","c","different-indirect"],[]) "int x = 15;",Str "."]
+,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["c","different-indirect","sourceCode"],[]) "int x = 15;",Str "."]
 ,Header 2 ("literal-symbols",[],[]) [Str "Literal",Space,Str "symbols"]
 ,Para [Str "2*2",Space,Str "=",Space,Str "4*1"]]