From 87e536b43805fc0a9f49c2fc8de9af88a241dc00 Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Fri, 5 Dec 2014 21:03:09 +0000
Subject: [PATCH 1/7] RST Reader: Warn about skipped directives
move `addWarning` to Parsing.hs, so it can be used by Markdown & RST readers.
---
src/Text/Pandoc/Parsing.hs | 8 ++++++++
src/Text/Pandoc/Readers/Markdown.hs | 6 ------
src/Text/Pandoc/Readers/RST.hs | 5 ++++-
3 files changed, 12 insertions(+), 7 deletions(-)
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index e0f5f65bb..416a7824a 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -162,6 +162,7 @@ module Text.Pandoc.Parsing ( anyLine,
setSourceColumn,
setSourceLine,
newPos,
+ addWarning
)
where
@@ -1245,3 +1246,10 @@ applyMacros' target = do
then do macros <- extractMacros <$> getState
return $ applyMacros macros target
else return target
+
+-- | Append a warning to the log.
+addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState ()
+addWarning mbpos msg =
+ updateState $ \st -> st{
+ stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :
+ stateWarnings st }
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index b8487b4e6..b70193ad3 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -343,12 +343,6 @@ parseMarkdown = do
let Pandoc _ bs = B.doc $ runF blocks st
return $ Pandoc meta bs
-addWarning :: Maybe SourcePos -> String -> MarkdownParser ()
-addWarning mbpos msg =
- updateState $ \st -> st{
- stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :
- stateWarnings st }
-
referenceKey :: MarkdownParser (F Blocks)
referenceKey = try $ do
pos <- getPosition
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 732956981..5c67629d6 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -608,7 +608,10 @@ directive' = do
"" -> block
_ -> parseFromString parseBlocks body'
return $ B.divWith attrs children
- _ -> return mempty
+ other -> do
+ pos <- getPosition
+ addWarning (Just pos) $ "ignoring unknown directive: " ++ other
+ return mempty
-- TODO:
-- - Silently ignores illegal fields
From 15816853a3611a96994842a34a975e91c253c7ab Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Fri, 5 Dec 2014 22:21:19 +0000
Subject: [PATCH 2/7] expose warnings from RST reader; refactor
This commit moves some code which was only used for the Markdown Reader
into a generic form which can be used for any Reader. Otherwise, it
takes naming and interface cues from the preexisting Markdown code.
---
src/Text/Pandoc.hs | 25 ++++++++++++-------------
src/Text/Pandoc/Parsing.hs | 10 ++++++++++
src/Text/Pandoc/Readers/Markdown.hs | 6 +-----
src/Text/Pandoc/Readers/RST.hs | 11 +++++++++--
4 files changed, 32 insertions(+), 20 deletions(-)
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 1f22122ac..d2bb85699 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -201,19 +201,18 @@ parseFormatSpec = parse formatSpec ""
'-' -> Set.delete ext
_ -> Set.insert ext
--- auxiliary function for readers:
-markdown :: ReaderOptions -> String -> IO Pandoc
-markdown o s = do
- let (doc, warnings) = readMarkdownWithWarnings o s
- mapM_ warn warnings
- return doc
-
data Reader = StringReader (ReaderOptions -> String -> IO Pandoc)
| ByteStringReader (ReaderOptions -> BL.ByteString -> IO (Pandoc, MediaBag))
mkStringReader :: (ReaderOptions -> String -> Pandoc) -> Reader
mkStringReader r = StringReader (\o s -> return $ r o s)
+mkStringReaderWithWarnings :: (ReaderOptions -> String -> (Pandoc, [String])) -> Reader
+mkStringReaderWithWarnings r = StringReader $ \o s -> do
+ let (doc, warnings) = r o s
+ mapM_ warn warnings
+ return doc
+
mkBSReader :: (ReaderOptions -> BL.ByteString -> (Pandoc, MediaBag)) -> Reader
mkBSReader r = ByteStringReader (\o s -> return $ r o s)
@@ -221,12 +220,12 @@ mkBSReader r = ByteStringReader (\o s -> return $ r o s)
readers :: [(String, Reader)]
readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)
,("json" , mkStringReader readJSON )
- ,("markdown" , StringReader markdown)
- ,("markdown_strict" , StringReader markdown)
- ,("markdown_phpextra" , StringReader markdown)
- ,("markdown_github" , StringReader markdown)
- ,("markdown_mmd", StringReader markdown)
- ,("rst" , mkStringReader readRST )
+ ,("markdown" , mkStringReaderWithWarnings readMarkdownWithWarnings)
+ ,("markdown_strict" , mkStringReaderWithWarnings readMarkdownWithWarnings)
+ ,("markdown_phpextra" , mkStringReaderWithWarnings readMarkdownWithWarnings)
+ ,("markdown_github" , mkStringReaderWithWarnings readMarkdownWithWarnings)
+ ,("markdown_mmd", mkStringReaderWithWarnings readMarkdownWithWarnings)
+ ,("rst" , mkStringReaderWithWarnings readRSTWithWarnings )
,("mediawiki" , mkStringReader readMediaWiki)
,("docbook" , mkStringReader readDocBook)
,("opml" , mkStringReader readOPML)
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 416a7824a..430cfca89 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -65,6 +65,7 @@ module Text.Pandoc.Parsing ( anyLine,
widthsFromIndices,
gridTableWith,
readWith,
+ readWithWarnings,
readWithM,
testStringWith,
guardEnabled,
@@ -881,6 +882,15 @@ readWith :: Parser [Char] st a
-> a
readWith p t inp = runIdentity $ readWithM p t inp
+readWithWarnings :: Parser [Char] ParserState a
+ -> ParserState
+ -> String
+ -> (a, [String])
+readWithWarnings p = readWith $ do
+ doc <- p
+ warnings <- stateWarnings <$> getState
+ return (doc, warnings)
+
-- | Parse a string with @parser@ (for testing).
testStringWith :: (Show a, Stream [Char] Identity Char)
=> ParserT [Char] ParserState Identity a
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index b70193ad3..2ca3b0eb6 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -79,11 +79,7 @@ readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse (assuming @'\n'@ line endings)
-> (Pandoc, [String])
readMarkdownWithWarnings opts s =
- (readWith parseMarkdownWithWarnings) def{ stateOptions = opts } (s ++ "\n\n")
- where parseMarkdownWithWarnings = do
- doc <- parseMarkdown
- warnings <- stateWarnings <$> getState
- return (doc, warnings)
+ (readWithWarnings parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")
trimInlinesF :: F Inlines -> F Inlines
trimInlinesF = liftM trimInlines
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 5c67629d6..20729e09a 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -29,7 +29,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion from reStructuredText to 'Pandoc' document.
-}
module Text.Pandoc.Readers.RST (
- readRST
+ readRST,
+ readRSTWithWarnings
) where
import Text.Pandoc.Definition
import Text.Pandoc.Builder (setMeta, fromList)
@@ -55,6 +56,9 @@ readRST :: ReaderOptions -- ^ Reader options
-> Pandoc
readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")
+readRSTWithWarnings :: ReaderOptions -> String -> (Pandoc, [String])
+readRSTWithWarnings opts s = (readWithWarnings parseRST) def{ stateOptions = opts } (s ++ "\n\n")
+
type RSTParser = Parser [Char] ParserState
--
@@ -1016,7 +1020,10 @@ renderRole contents fmt role attr = case role of
fmtStr = fmt `mplus` newFmt
(newRole, newAttr) = inherit attr
in renderRole contents fmtStr newRole newAttr
- Nothing -> return $ B.str contents -- Undefined role
+ Nothing -> do
+ pos <- getPosition
+ addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in "
+ return $ B.str contents -- Undefined role
where
titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour
rfcLink rfcNo = B.link rfcUrl ("RFC " ++ rfcNo) $ B.str ("RFC " ++ rfcNo)
From dba066a33def2635567dc790f04387a06297e903 Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Mon, 8 Dec 2014 16:41:18 +0000
Subject: [PATCH 3/7] RST: literal role should produce Code,
code role should have "code" class.
http://docutils.sourceforge.net/docs/ref/rst/roles.html says that
`text`:literal` is the same as ``text``. docutils outputs a <literal>
element in both cases, whereas for the code role, it outputs a <literal>
element with the "code" class.
---
src/Text/Pandoc/Readers/RST.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 20729e09a..98d43221b 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -1006,12 +1006,12 @@ renderRole contents fmt role attr = case role of
"RFC" -> return $ rfcLink contents
"pep-reference" -> return $ pepLink contents
"PEP" -> return $ pepLink contents
- "literal" -> return $ B.str contents
+ "literal" -> return $ B.codeWith attr contents
"math" -> return $ B.math contents
"title-reference" -> titleRef contents
"title" -> titleRef contents
"t" -> titleRef contents
- "code" -> return $ B.codeWith attr contents
+ "code" -> return $ B.codeWith (union attr ["code"]) contents
"raw" -> return $ B.rawInline (fromMaybe "" fmt) contents
custom -> do
customRole <- stateRstCustomRoles <$> getState
From dc3ea9840e301b5d18760050ec2dc50bdb4de509 Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Thu, 11 Dec 2014 16:12:06 +0000
Subject: [PATCH 4/7] RST reader: improve support for custom roles
- Add "sourceCode" to classes for :code: role, and anything inheriting
from it.
- Add the name of the custom role to classes if the Inline constructor
supports Attr.
- If the custom role directive does not specify a parent role, inherit
from the :span: role.
This differs somewhat from the rst2xml.py behavior. If a custom role
inherits from another custom role, Pandoc will attach both roles' names
as classes. rst2xml.py will only use the class of the directly invoked
role (though in the case of inheriting from a :code: role with a
:language: defined, it will also provide the inherited language as a
class).
---
src/Text/Pandoc/Readers/RST.hs | 25 ++++++++++++++-----------
1 file changed, 14 insertions(+), 11 deletions(-)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 98d43221b..5d550f7b7 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -39,11 +39,11 @@ import Text.Pandoc.Parsing
import Text.Pandoc.Options
import Control.Monad ( when, liftM, guard, mzero, mplus )
import Data.List ( findIndex, intersperse, intercalate,
- transpose, sort, deleteFirstsBy, isSuffixOf )
+ transpose, sort, deleteFirstsBy, isSuffixOf , nub, union)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Text.Printf ( printf )
-import Control.Applicative ((<$>), (<$), (<*), (*>), (<*>))
+import Control.Applicative ((<$>), (<$), (<*), (*>), (<*>), pure)
import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
import qualified Text.Pandoc.Builder as B
import Data.Monoid (mconcat, mempty)
@@ -619,7 +619,6 @@ directive' = do
-- TODO:
-- - Silently ignores illegal fields
--- - Silently drops classes
-- - Only supports :format: fields with a single format for :raw: roles,
-- change Text.Pandoc.Definition.Format to fix
addNewRole :: String -> [(String, String)] -> RSTParser Blocks
@@ -631,7 +630,7 @@ addNewRole roleString fields = do
Nothing -> return parentRole
let fmt = if baseRole == "raw" then lookup "format" fields else Nothing
- annotate = maybe id addLanguage $
+ annotate = maybe (addClass role) (addLanguage role) $
if baseRole == "code"
then lookup "language" fields
else Nothing
@@ -643,10 +642,10 @@ addNewRole roleString fields = do
return $ B.singleton Null
where
- addLanguage lang (ident, classes, keyValues) =
- (ident, "sourceCode" : lang : classes, keyValues)
+ addLanguage role lang (ident, classes, keyValues) =
+ (ident, nub ("sourceCode" : lang : role : classes), keyValues)
inheritedRole =
- (,) <$> roleNameEndingIn (char '(') <*> roleNameEndingIn (char ')')
+ (,) <$> roleName <*> ((char '(' *> roleName <* char ')') <|> pure "span")
-- Can contain character codes as decimal numbers or
-- hexadecimal numbers, prefixed by 0x, x, \x, U+, u, or \u
@@ -1011,7 +1010,8 @@ renderRole contents fmt role attr = case role of
"title-reference" -> titleRef contents
"title" -> titleRef contents
"t" -> titleRef contents
- "code" -> return $ B.codeWith (union attr ["code"]) contents
+ "code" -> return $ B.codeWith (addClass "sourceCode" attr) contents
+ "span" -> return $ B.spanWith attr $ B.str contents
"raw" -> return $ B.rawInline (fromMaybe "" fmt) contents
custom -> do
customRole <- stateRstCustomRoles <$> getState
@@ -1032,11 +1032,14 @@ renderRole contents fmt role attr = case role of
where padNo = replicate (4 - length pepNo) '0' ++ pepNo
pepUrl = "http://www.python.org/dev/peps/pep-" ++ padNo ++ "/"
-roleNameEndingIn :: RSTParser Char -> RSTParser String
-roleNameEndingIn end = many1Till (letter <|> char '-') end
+addClass :: String -> Attr -> Attr
+addClass c (ident, classes, keyValues) = (ident, union classes [c], keyValues)
+
+roleName :: RSTParser String
+roleName = many1 (letter <|> char '-')
roleMarker :: RSTParser String
-roleMarker = char ':' *> roleNameEndingIn (char ':')
+roleMarker = char ':' *> roleName <* char ':'
roleBefore :: RSTParser (String,String)
roleBefore = try $ do
From 4e040160e0fce94a07e7ab5b4c5aebcf627ff1f6 Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Thu, 11 Dec 2014 17:14:03 +0000
Subject: [PATCH 5/7] WIP: tests for RST roles
---
tests/Tests/Readers/RST.hs | 55 +++++++++++++++++++++++++-------------
tests/rst-reader.native | 4 +--
2 files changed, 39 insertions(+), 20 deletions(-)
diff --git a/tests/Tests/Readers/RST.hs b/tests/Tests/Readers/RST.hs
index c97dcb149..9d5a8425b 100644
--- a/tests/Tests/Readers/RST.hs
+++ b/tests/Tests/Readers/RST.hs
@@ -67,26 +67,45 @@ tests = [ "line block with blank line" =:
link "http://foo.bar.baz" "" "http://foo.bar.baz" <> ". " <>
link "http://foo.bar/baz_(bam)" "" "http://foo.bar/baz_(bam)"
<> " (" <> link "http://foo.bar" "" "http://foo.bar" <> ")")
- , "indented literal block" =: unlines
- [ "::"
- , ""
- , " block quotes"
- , ""
- , " can go on for many lines"
- , "but must stop here"]
- =?> (doc $
- codeBlock "block quotes\n\ncan go on for many lines" <>
- para "but must stop here")
- , "line block with 3 lines" =: "| a\n| b\n| c"
- =?> para ("a" <> linebreak <> "b" <> linebreak <> "c")
+ , testGroup "literal / line / code blocks"
+ [ "indented literal block" =: unlines
+ [ "::"
+ , ""
+ , " block quotes"
+ , ""
+ , " can go on for many lines"
+ , "but must stop here"]
+ =?> (doc $
+ codeBlock "block quotes\n\ncan go on for many lines" <>
+ para "but must stop here")
+ , "line block with 3 lines" =: "| a\n| b\n| c"
+ =?> para ("a" <> linebreak <> "b" <> linebreak <> "c")
, "quoted literal block using >" =: "::\n\n> quoted\n> block\n\nOrdinary paragraph"
=?> codeBlock "> quoted\n> block" <> para "Ordinary paragraph"
, "quoted literal block using | (not a line block)" =: "::\n\n| quoted\n| block\n\nOrdinary paragraph"
=?> codeBlock "| quoted\n| block" <> para "Ordinary paragraph"
- , "class directive with single paragraph" =: ".. class:: special\n\nThis is a \"special\" paragraph."
- =?> divWith ("", ["special"], []) (para "This is a \"special\" paragraph.")
- , "class directive with two paragraphs" =: ".. class:: exceptional remarkable\n\n First paragraph.\n\n Second paragraph."
- =?> divWith ("", ["exceptional", "remarkable"], []) (para "First paragraph." <> para "Second paragraph.")
- , "class directive around literal block" =: ".. class:: classy\n\n::\n\n a\n b"
- =?> divWith ("", ["classy"], []) (codeBlock "a\nb")
+ , "class directive with single paragraph" =: ".. class:: special\n\nThis is a \"special\" paragraph."
+ =?> divWith ("", ["special"], []) (para "This is a \"special\" paragraph.")
+ , "class directive with two paragraphs" =: ".. class:: exceptional remarkable\n\n First paragraph.\n\n Second paragraph."
+ =?> divWith ("", ["exceptional", "remarkable"], []) (para "First paragraph." <> para "Second paragraph.")
+ , "class directive around literal block" =: ".. class:: classy\n\n::\n\n a\n b"
+ =?> divWith ("", ["classy"], []) (codeBlock "a\nb")]
+ , testGroup "interpreted text roles"
+ [ "literal role prefix" =: ":literal:`a`" =?> para (code "a")
+ , "literal role postfix" =: "`a`:literal:" =?> para (code "a")
+ , "literal text" =: "``text``" =?> para (code "text")
+ , "code role" =: ":code:`a`" =?> para (codeWith ("", ["sourceCode"], []) "a")
+ , "inherited code role" =: ".. role:: codeLike(code)\n\n:codeLike:`a`"
+ =?> 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")
+ , "custom role with unspecified parent role"
+ =: ".. role:: classy\n\n:classy:`text`"
+ =?> para (spanWith ("", ["classy"], []) "text")
+ , "role with recursive inheritance"
+ =: ".. role:: haskell(code)\n.. role:: lhs(haskell)\n\n:lhs:`text`"
+ =?> para (codeWith ("", ["lhs", "haskell", "sourceCode"], []) "text")
+ , "unknown role" =: ":unknown:`text`" =?> para (str "text")
+ ]
]
diff --git a/tests/rst-reader.native b/tests/rst-reader.native
index c77d15775..5d0c4faac 100644
--- a/tests/rst-reader.native
+++ b/tests/rst-reader.native
@@ -325,9 +325,9 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa
,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["sourceCode","haskell"],[]) "fmap id [1,2..10]",Str "."]
,Null
,Null
-,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["sourceCode","python"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]
+,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 "."]
,Null
,Null
-,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["sourceCode","c"],[]) "int x = 15;",Str "."]
+,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["sourceCode","c","different-indirect"],[]) "int x = 15;",Str "."]
,Header 2 ("literal-symbols",[],[]) [Str "Literal",Space,Str "symbols"]
,Para [Str "2*2",Space,Str "=",Space,Str "4*1"]]
From 689fb112bf925ce5394f88b48066be8abdc7fc34 Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Thu, 11 Dec 2014 18:50:24 +0000
Subject: [PATCH 6/7] 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 | 5 ++---
src/Text/Pandoc/Readers/RST.hs | 28 ++++++++++++++--------------
tests/Tests/Readers/RST.hs | 2 +-
tests/rst-reader.native | 6 +++---
4 files changed, 20 insertions(+), 21 deletions(-)
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 430cfca89..4503e31fd 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/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
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 5d550f7b7..0a5c3bcb4 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/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 "
diff --git a/tests/Tests/Readers/RST.hs b/tests/Tests/Readers/RST.hs
index 9d5a8425b..1aaf4897f 100644
--- a/tests/Tests/Readers/RST.hs
+++ b/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")
diff --git a/tests/rst-reader.native b/tests/rst-reader.native
index 5d0c4faac..1f402f835 100644
--- a/tests/rst-reader.native
+++ b/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"]]
From ea157cf23fa3bdd60c86599a0791d9492d6bd0bb Mon Sep 17 00:00:00 2001
From: Daniel Bergey <bergey@alum.mit.edu>
Date: Thu, 11 Dec 2014 19:21:27 +0000
Subject: [PATCH 7/7] RST: warn about ignored fields in role directives
---
src/Text/Pandoc/Readers/RST.hs | 32 ++++++++++++++++++++++++++------
1 file changed, 26 insertions(+), 6 deletions(-)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 0a5c3bcb4..8bfc6f606 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -37,7 +37,7 @@ import Text.Pandoc.Builder (setMeta, fromList)
import Text.Pandoc.Shared
import Text.Pandoc.Parsing
import Text.Pandoc.Options
-import Control.Monad ( when, liftM, guard, mzero, mplus )
+import Control.Monad ( when, liftM, guard, mzero )
import Data.List ( findIndex, intersperse, intercalate,
transpose, sort, deleteFirstsBy, isSuffixOf , nub, union)
import Data.Maybe (fromMaybe)
@@ -628,17 +628,35 @@ addNewRole roleString fields = do
let (baseRole, baseFmt, baseAttr) =
maybe (parentRole, Nothing, nullAttr) id $
M.lookup parentRole customRoles
-
- let fmt = if parentRole == "raw" then lookup "format" fields else baseFmt
- -- nub in case role name & language class are the same
+ fmt = if parentRole == "raw" then lookup "format" fields else baseFmt
annotate :: [String] -> [String]
annotate = maybe id (:) $
- if baseRole == "code"
+ if parentRole == "code"
then lookup "language" fields
else Nothing
attr = let (ident, classes, keyValues) = baseAttr
+ -- nub in case role name & language class are the same
in (ident, nub . (role :) . annotate $ classes, keyValues)
+ -- warn about syntax we ignore
+ flip mapM_ fields $ \(key, _) -> case key of
+ "language" -> when (parentRole /= "code") $ addWarning Nothing $
+ "ignoring :language: field because the parent of role :" ++
+ role ++ ": is :" ++ parentRole ++ ": not :code:"
+ "format" -> when (parentRole /= "raw") $ addWarning Nothing $
+ "ignoring :format: field because the parent of role :" ++
+ role ++ ": is :" ++ parentRole ++ ": not :raw:"
+ _ -> addWarning Nothing $ "ignoring unknown field :" ++ key ++
+ ": in definition of role :" ++ role ++ ": in"
+ when (parentRole == "raw" && countKeys "format" > 1) $
+ addWarning Nothing $
+ "ignoring :format: fields after the first in the definition of role :"
+ ++ role ++": in"
+ when (parentRole == "code" && countKeys "language" > 1) $
+ addWarning Nothing $
+ "ignoring :language: fields after the first in the definition of role :"
+ ++ role ++": in"
+
updateState $ \s -> s {
stateRstCustomRoles =
M.insert role (baseRole, fmt, attr) customRoles
@@ -646,9 +664,11 @@ addNewRole roleString fields = do
return $ B.singleton Null
where
+ countKeys k = length . filter (== k) . map fst $ fields
inheritedRole =
(,) <$> roleName <*> ((char '(' *> roleName <* char ')') <|> pure "span")
+
-- Can contain character codes as decimal numbers or
-- hexadecimal numbers, prefixed by 0x, x, \x, U+, u, or \u
-- or as XML-style hexadecimal character entities, e.g. ᨫ
@@ -1022,7 +1042,7 @@ renderRole contents fmt role attr = case role of
renderRole contents newFmt newRole newAttr
Nothing -> do
pos <- getPosition
- addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in "
+ addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in"
return $ B.str contents -- Undefined role
where
titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour