RST reader: better handling of indirect roles.
Previously the parser failed on this kind of case .. role:: indirect(code) .. role:: py(indirect) :language: python :py:`hi` Now it currectly recognizes `:py:` as a code role. The previous test for this didn't work, because the name of the indirect role was the same as the language defined its parent, os it didn't really test for this behavior. Updated test.
This commit is contained in:
parent
8c579a5daa
commit
1f00a5395f
3 changed files with 14 additions and 12 deletions
|
@ -614,20 +614,22 @@ directive' = do
|
|||
return mempty
|
||||
|
||||
-- TODO:
|
||||
-- - Silently ignores illegal fields
|
||||
-- - Only supports :format: fields with a single format for :raw: roles,
|
||||
-- change Text.Pandoc.Definition.Format to fix
|
||||
addNewRole :: String -> [(String, String)] -> RSTParser Blocks
|
||||
addNewRole roleString fields = do
|
||||
(role, parentRole) <- parseFromString inheritedRole roleString
|
||||
customRoles <- stateRstCustomRoles <$> getState
|
||||
let (baseRole, baseFmt, baseAttr) =
|
||||
maybe (parentRole, Nothing, nullAttr) id $
|
||||
M.lookup parentRole customRoles
|
||||
let getBaseRole (r, f, a) roles =
|
||||
case M.lookup r roles of
|
||||
Just (r', f', a') -> getBaseRole (r', f', a') roles
|
||||
Nothing -> (r, f, a)
|
||||
(baseRole, baseFmt, baseAttr) =
|
||||
getBaseRole (parentRole, Nothing, nullAttr) customRoles
|
||||
fmt = if parentRole == "raw" then lookup "format" fields else baseFmt
|
||||
annotate :: [String] -> [String]
|
||||
annotate = maybe id (:) $
|
||||
if parentRole == "code"
|
||||
if baseRole == "code"
|
||||
then lookup "language" fields
|
||||
else Nothing
|
||||
attr = let (ident, classes, keyValues) = baseAttr
|
||||
|
@ -636,12 +638,12 @@ addNewRole roleString fields = do
|
|||
|
||||
-- warn about syntax we ignore
|
||||
flip mapM_ fields $ \(key, _) -> case key of
|
||||
"language" -> when (parentRole /= "code") $ addWarning Nothing $
|
||||
"language" -> when (baseRole /= "code") $ addWarning Nothing $
|
||||
"ignoring :language: field because the parent of role :" ++
|
||||
role ++ ": is :" ++ parentRole ++ ": not :code:"
|
||||
"format" -> when (parentRole /= "raw") $ addWarning Nothing $
|
||||
role ++ ": is :" ++ baseRole ++ ": not :code:"
|
||||
"format" -> when (baseRole /= "raw") $ addWarning Nothing $
|
||||
"ignoring :format: field because the parent of role :" ++
|
||||
role ++ ": is :" ++ parentRole ++ ": not :raw:"
|
||||
role ++ ": is :" ++ baseRole ++ ": not :raw:"
|
||||
_ -> addWarning Nothing $ "ignoring unknown field :" ++ key ++
|
||||
": in definition of role :" ++ role ++ ": in"
|
||||
when (parentRole == "raw" && countKeys "format" > 1) $
|
||||
|
|
|
@ -325,7 +325,7 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
|
|||
,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 ("",["python","indirect","sourceCode"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]
|
||||
,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["py","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 ("",["c","different-indirect","sourceCode"],[]) "int x = 15;",Str "."]
|
||||
|
|
|
@ -611,10 +611,10 @@ And some inline haskell :haskell:`fmap id [1,2..10]`.
|
|||
|
||||
.. role:: indirect(code)
|
||||
|
||||
.. role:: python(indirect)
|
||||
.. role:: py(indirect)
|
||||
:language: python
|
||||
|
||||
Indirect python role :python:`[x*x for x in [1,2,3,4,5]]`.
|
||||
Indirect python role :py:`[x*x for x in [1,2,3,4,5]]`.
|
||||
|
||||
.. role:: different-indirect(code)
|
||||
:language: c
|
||||
|
|
Loading…
Add table
Reference in a new issue