aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc.hs25
-rw-r--r--src/Text/Pandoc/Parsing.hs23
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs12
-rw-r--r--src/Text/Pandoc/Readers/RST.hs91
4 files changed, 95 insertions, 56 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 8dfc6dd57..18f38e564 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,
@@ -162,6 +163,7 @@ module Text.Pandoc.Parsing ( anyLine,
setSourceColumn,
setSourceLine,
newPos,
+ addWarning
)
where
@@ -880,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
@@ -910,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
@@ -1245,3 +1255,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..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
@@ -343,12 +339,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..8bfc6f606 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -29,20 +29,21 @@ 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)
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 )
+ 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)
@@ -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
--
@@ -608,38 +612,62 @@ 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
--- - 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
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 id addLanguage $
- if baseRole == "code"
+ let (baseRole, baseFmt, baseAttr) =
+ maybe (parentRole, Nothing, nullAttr) id $
+ M.lookup parentRole customRoles
+ fmt = if parentRole == "raw" then lookup "format" fields else baseFmt
+ annotate :: [String] -> [String]
+ annotate = maybe id (:) $
+ 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, (,) parentRole . annotate) customRoles
+ M.insert role (baseRole, fmt, attr) customRoles
}
return $ B.singleton Null
where
- addLanguage lang (ident, classes, keyValues) =
- (ident, "sourceCode" : lang : classes, keyValues)
+ countKeys k = length . filter (== k) . map fst $ fields
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
@@ -999,21 +1027,23 @@ 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 (addClass "sourceCode" attr) contents
+ "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
- Nothing -> return $ B.str contents -- Undefined role
+ 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"
+ 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)
@@ -1022,11 +1052,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
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-30 15:25:08 +0000