From 87e536b43805fc0a9f49c2fc8de9af88a241dc00 Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Fri, 5 Dec 2014 21:03:09 +0000 Subject: RST Reader: Warn about skipped directives move `addWarning` to Parsing.hs, so it can be used by Markdown & RST readers. --- src/Text/Pandoc/Readers/Markdown.hs | 6 ------ src/Text/Pandoc/Readers/RST.hs | 5 ++++- 2 files changed, 4 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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 -- cgit v1.2.3 From 15816853a3611a96994842a34a975e91c253c7ab Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Fri, 5 Dec 2014 22:21:19 +0000 Subject: 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/Readers/Markdown.hs | 6 +----- src/Text/Pandoc/Readers/RST.hs | 11 +++++++++-- 2 files changed, 10 insertions(+), 7 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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) -- cgit v1.2.3 From dba066a33def2635567dc790f04387a06297e903 Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Mon, 8 Dec 2014 16:41:18 +0000 Subject: 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 element in both cases, whereas for the code role, it outputs a element with the "code" class. --- src/Text/Pandoc/Readers/RST.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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 -- cgit v1.2.3 From dc3ea9840e301b5d18760050ec2dc50bdb4de509 Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Thu, 11 Dec 2014 16:12:06 +0000 Subject: 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(-) (limited to 'src/Text/Pandoc/Readers') 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 -- cgit v1.2.3 From 689fb112bf925ce5394f88b48066be8abdc7fc34 Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Thu, 11 Dec 2014 18:50:24 +0000 Subject: 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/Readers/RST.hs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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 fmt = if baseRole == "raw" then lookup "format" fields else Nothing - annotate = maybe (addClass role) (addLanguage role) $ + 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 + 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 " -- cgit v1.2.3 From ea157cf23fa3bdd60c86599a0791d9492d6bd0bb Mon Sep 17 00:00:00 2001 From: Daniel Bergey Date: Thu, 11 Dec 2014 19:21:27 +0000 Subject: RST: warn about ignored fields in role directives --- src/Text/Pandoc/Readers/RST.hs | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc/Readers') 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 -- cgit v1.2.3