a864e9a · typeable/pandoc

git.iko.soy/typeable/pandoc

Merge pull request #1805 from bergey/rst

RST Reader - Improved Role Support

commita864e9a348dba4f4630999cb7a65c2ed3ce09308 authorJohn MacFarlane <jgm@berkeley.edu> dateMon 15 Dec 2014, 09:06 (12 years ago) parent9e75b9b ea157cf

6 files changed+135−77

compare with master

unifiedsplit

src/Text/Pandoc.hs+12−13 src/Text/Pandoc/Parsing.hs+20−3 src/Text/Pandoc/Readers/Markdown.hs+1−11 src/Text/Pandoc/Readers/RST.hs+62−29 tests/Tests/Readers/RST.hs+37−18 tests/rst-reader.native+3−3

src/Text/Pandoc.hs+12−13

@@ -201,19 +201,18 @@ parseFormatSpec = parse formatSpec ""

201201 '-' -> Set.delete ext

202202 _ -> Set.insert ext

203203

204−-- auxiliary function for readers:

205−markdown :: ReaderOptions -> String -> IO Pandoc

206−markdown o s = do

207− let (doc, warnings) = readMarkdownWithWarnings o s

208− mapM_ warn warnings

209− return doc

210−

211204data Reader = StringReader (ReaderOptions -> String -> IO Pandoc)

212205 | ByteStringReader (ReaderOptions -> BL.ByteString -> IO (Pandoc, MediaBag))

213206

214207mkStringReader :: (ReaderOptions -> String -> Pandoc) -> Reader

215208mkStringReader r = StringReader (\o s -> return $ r o s)

216209

210+mkStringReaderWithWarnings :: (ReaderOptions -> String -> (Pandoc, [String])) -> Reader

211+mkStringReaderWithWarnings r = StringReader $ \o s -> do

212+ let (doc, warnings) = r o s

213+ mapM_ warn warnings

214+ return doc

215+

217216mkBSReader :: (ReaderOptions -> BL.ByteString -> (Pandoc, MediaBag)) -> Reader

218217mkBSReader r = ByteStringReader (\o s -> return $ r o s)

219218

@@ -221,12 +220,12 @@ mkBSReader r = ByteStringReader (\o s -> return $ r o s)

221220readers :: [(String, Reader)]

222221readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)

223222 ,("json" , mkStringReader readJSON )

224− ,("markdown" , StringReader markdown)

225− ,("markdown_strict" , StringReader markdown)

226− ,("markdown_phpextra" , StringReader markdown)

227− ,("markdown_github" , StringReader markdown)

228− ,("markdown_mmd", StringReader markdown)

229− ,("rst" , mkStringReader readRST )

223+ ,("markdown" , mkStringReaderWithWarnings readMarkdownWithWarnings)

224+ ,("markdown_strict" , mkStringReaderWithWarnings readMarkdownWithWarnings)

225+ ,("markdown_phpextra" , mkStringReaderWithWarnings readMarkdownWithWarnings)

226+ ,("markdown_github" , mkStringReaderWithWarnings readMarkdownWithWarnings)

227+ ,("markdown_mmd", mkStringReaderWithWarnings readMarkdownWithWarnings)

228+ ,("rst" , mkStringReaderWithWarnings readRSTWithWarnings )

230229 ,("mediawiki" , mkStringReader readMediaWiki)

231230 ,("docbook" , mkStringReader readDocBook)

232231 ,("opml" , mkStringReader readOPML)

src/Text/Pandoc/Parsing.hs+20−3

@@ -65,6 +65,7 @@ module Text.Pandoc.Parsing ( anyLine,

6565 widthsFromIndices,

6666 gridTableWith,

6767 readWith,

68+ readWithWarnings,

6869 readWithM,

6970 testStringWith,

7071 guardEnabled,

@@ -162,6 +163,7 @@ module Text.Pandoc.Parsing ( anyLine,

162163 setSourceColumn,

163164 setSourceLine,

164165 newPos,

166+ addWarning

165167 )

166168where

167169

@@ -880,6 +882,15 @@ readWith :: Parser [Char] st a

880882 -> a

881883readWith p t inp = runIdentity $ readWithM p t inp

882884

885+readWithWarnings :: Parser [Char] ParserState a

886+ -> ParserState

887+ -> String

888+ -> (a, [String])

889+readWithWarnings p = readWith $ do

890+ doc <- p

891+ warnings <- stateWarnings <$> getState

892+ return (doc, warnings)

893+

883894-- | Parse a string with @parser@ (for testing).

884895testStringWith :: (Show a, Stream [Char] Identity Char)

885896 => ParserT [Char] ParserState Identity a

@@ -910,10 +921,9 @@ data ParserState = ParserState

910921 stateHasChapters :: Bool, -- ^ True if \chapter encountered

911922 stateMacros :: [Macro], -- ^ List of macros defined so far

912923 stateRstDefaultRole :: String, -- ^ Current rST default interpreted text role

913− stateRstCustomRoles :: M.Map String (String, Maybe String, Attr -> (String, Attr)), -- ^ Current rST custom text roles

924+ stateRstCustomRoles :: M.Map String (String, Maybe String, Attr), -- ^ Current rST custom text roles

914925 -- Triple represents: 1) Base role, 2) Optional format (only for :raw:

915− -- roles), 3) Source language annotation for code (could be used to

916− -- annotate role classes too).

926+ -- roles), 3) Additional classes (rest of Attr is unused)).

917927 stateCaption :: Maybe Inlines, -- ^ Caption in current environment

918928 stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed

919929 stateMarkdownAttribute :: Bool, -- ^ True if in markdown=1 context

@@ -1245,3 +1255,10 @@ applyMacros' target = do

12451255 then do macros <- extractMacros <$> getState

12461256 return $ applyMacros macros target

12471257 else return target

1258+

1259+-- | Append a warning to the log.

1260+addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState ()

1261+addWarning mbpos msg =

1262+ updateState $ \st -> st{

1263+ stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :

1264+ stateWarnings st }

src/Text/Pandoc/Readers/Markdown.hs+1−11

@@ -79,11 +79,7 @@ readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

7979 -> String -- ^ String to parse (assuming @'\n'@ line endings)

8080 -> (Pandoc, [String])

8181readMarkdownWithWarnings opts s =

82− (readWith parseMarkdownWithWarnings) def{ stateOptions = opts } (s ++ "\n\n")

83− where parseMarkdownWithWarnings = do

84− doc <- parseMarkdown

85− warnings <- stateWarnings <$> getState

86− return (doc, warnings)

82+ (readWithWarnings parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

8783

8884trimInlinesF :: F Inlines -> F Inlines

8985trimInlinesF = liftM trimInlines

@@ -343,12 +339,6 @@ parseMarkdown = do

343339 let Pandoc _ bs = B.doc $ runF blocks st

344340 return $ Pandoc meta bs

345341

346−addWarning :: Maybe SourcePos -> String -> MarkdownParser ()

347−addWarning mbpos msg =

348− updateState $ \st -> st{

349− stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :

350− stateWarnings st }

351−

352342referenceKey :: MarkdownParser (F Blocks)

353343referenceKey = try $ do

354344 pos <- getPosition

src/Text/Pandoc/Readers/RST.hs+62−29

@@ -29,20 +29,21 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

2929Conversion from reStructuredText to 'Pandoc' document.

3030-}

3131module Text.Pandoc.Readers.RST (

32− readRST

32+ readRST,

33+ readRSTWithWarnings

3334 ) where

3435import Text.Pandoc.Definition

3536import Text.Pandoc.Builder (setMeta, fromList)

3637import Text.Pandoc.Shared

3738import Text.Pandoc.Parsing

3839import Text.Pandoc.Options

39−import Control.Monad ( when, liftM, guard, mzero, mplus )

40+import Control.Monad ( when, liftM, guard, mzero )

4041import Data.List ( findIndex, intersperse, intercalate,

41− transpose, sort, deleteFirstsBy, isSuffixOf )

42+ transpose, sort, deleteFirstsBy, isSuffixOf , nub, union)

4243import Data.Maybe (fromMaybe)

4344import qualified Data.Map as M

4445import Text.Printf ( printf )

45−import Control.Applicative ((<$>), (<$), (<*), (*>), (<*>))

46+import Control.Applicative ((<$>), (<$), (<*), (*>), (<*>), pure)

4647import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))

4748import qualified Text.Pandoc.Builder as B

4849import Data.Monoid (mconcat, mempty)

@@ -55,6 +56,9 @@ readRST :: ReaderOptions -- ^ Reader options

5556 -> Pandoc

5657readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")

5758

59+readRSTWithWarnings :: ReaderOptions -> String -> (Pandoc, [String])

60+readRSTWithWarnings opts s = (readWithWarnings parseRST) def{ stateOptions = opts } (s ++ "\n\n")

61+

5862type RSTParser = Parser [Char] ParserState

5963

6064--

@@ -608,38 +612,62 @@ directive' = do

608612 "" -> block

609613 _ -> parseFromString parseBlocks body'

610614 return $ B.divWith attrs children

611− _ -> return mempty

615+ other -> do

616+ pos <- getPosition

617+ addWarning (Just pos) $ "ignoring unknown directive: " ++ other

618+ return mempty

612619

613620-- TODO:

614621-- - Silently ignores illegal fields

615−-- - Silently drops classes

616622-- - Only supports :format: fields with a single format for :raw: roles,

617623-- change Text.Pandoc.Definition.Format to fix

618624addNewRole :: String -> [(String, String)] -> RSTParser Blocks

619625addNewRole roleString fields = do

620626 (role, parentRole) <- parseFromString inheritedRole roleString

621627 customRoles <- stateRstCustomRoles <$> getState

622− baseRole <- case M.lookup parentRole customRoles of

623− Just (base, _, _) -> return base

624− Nothing -> return parentRole

625−

626− let fmt = if baseRole == "raw" then lookup "format" fields else Nothing

627− annotate = maybe id addLanguage $

628− if baseRole == "code"

628+ let (baseRole, baseFmt, baseAttr) =

629+ maybe (parentRole, Nothing, nullAttr) id $

630+ M.lookup parentRole customRoles

631+ fmt = if parentRole == "raw" then lookup "format" fields else baseFmt

632+ annotate :: [String] -> [String]

633+ annotate = maybe id (:) $

634+ if parentRole == "code"

629635 then lookup "language" fields

630636 else Nothing

637+ attr = let (ident, classes, keyValues) = baseAttr

638+ -- nub in case role name & language class are the same

639+ in (ident, nub . (role :) . annotate $ classes, keyValues)

640+

641+ -- warn about syntax we ignore

642+ flip mapM_ fields $ \(key, _) -> case key of

643+ "language" -> when (parentRole /= "code") $ addWarning Nothing $

644+ "ignoring :language: field because the parent of role :" ++

645+ role ++ ": is :" ++ parentRole ++ ": not :code:"

646+ "format" -> when (parentRole /= "raw") $ addWarning Nothing $

647+ "ignoring :format: field because the parent of role :" ++

648+ role ++ ": is :" ++ parentRole ++ ": not :raw:"

649+ _ -> addWarning Nothing $ "ignoring unknown field :" ++ key ++

650+ ": in definition of role :" ++ role ++ ": in"

651+ when (parentRole == "raw" && countKeys "format" > 1) $

652+ addWarning Nothing $

653+ "ignoring :format: fields after the first in the definition of role :"

654+ ++ role ++": in"

655+ when (parentRole == "code" && countKeys "language" > 1) $

656+ addWarning Nothing $

657+ "ignoring :language: fields after the first in the definition of role :"

658+ ++ role ++": in"

631659

632660 updateState $ \s -> s {

633661 stateRstCustomRoles =

634− M.insert role (baseRole, fmt, (,) parentRole . annotate) customRoles

662+ M.insert role (baseRole, fmt, attr) customRoles

635663 }

636664

637665 return $ B.singleton Null

638666 where

639− addLanguage lang (ident, classes, keyValues) =

640− (ident, "sourceCode" : lang : classes, keyValues)

667+ countKeys k = length . filter (== k) . map fst $ fields

641668 inheritedRole =

642− (,) <$> roleNameEndingIn (char '(') <*> roleNameEndingIn (char ')')

669+ (,) <$> roleName <*> ((char '(' *> roleName <* char ')') <|> pure "span")

670+

643671

644672-- Can contain character codes as decimal numbers or

645673-- hexadecimal numbers, prefixed by 0x, x, \x, U+, u, or \u

@@ -999,21 +1027,23 @@ renderRole contents fmt role attr = case role of

9991027 "RFC" -> return $ rfcLink contents

10001028 "pep-reference" -> return $ pepLink contents

10011029 "PEP" -> return $ pepLink contents

1002− "literal" -> return $ B.str contents

1030+ "literal" -> return $ B.codeWith attr contents

10031031 "math" -> return $ B.math contents

10041032 "title-reference" -> titleRef contents

10051033 "title" -> titleRef contents

10061034 "t" -> titleRef contents

1007− "code" -> return $ B.codeWith attr contents

1035+ "code" -> return $ B.codeWith (addClass "sourceCode" attr) contents

1036+ "span" -> return $ B.spanWith attr $ B.str contents

10081037 "raw" -> return $ B.rawInline (fromMaybe "" fmt) contents

10091038 custom -> do

1010− customRole <- stateRstCustomRoles <$> getState

1011− case M.lookup custom customRole of

1012− Just (_, newFmt, inherit) -> let

1013− fmtStr = fmt `mplus` newFmt

1014− (newRole, newAttr) = inherit attr

1015− in renderRole contents fmtStr newRole newAttr

1016− Nothing -> return $ B.str contents -- Undefined role

1039+ customRoles <- stateRstCustomRoles <$> getState

1040+ case M.lookup custom customRoles of

1041+ Just (newRole, newFmt, newAttr) ->

1042+ renderRole contents newFmt newRole newAttr

1043+ Nothing -> do

1044+ pos <- getPosition

1045+ addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in"

1046+ return $ B.str contents -- Undefined role

10171047 where

10181048 titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour

10191049 rfcLink rfcNo = B.link rfcUrl ("RFC " ++ rfcNo) $ B.str ("RFC " ++ rfcNo)

@@ -1022,11 +1052,14 @@ renderRole contents fmt role attr = case role of

10221052 where padNo = replicate (4 - length pepNo) '0' ++ pepNo

10231053 pepUrl = "http://www.python.org/dev/peps/pep-" ++ padNo ++ "/"

10241054

1025−roleNameEndingIn :: RSTParser Char -> RSTParser String

1026−roleNameEndingIn end = many1Till (letter <|> char '-') end

1055+addClass :: String -> Attr -> Attr

1056+addClass c (ident, classes, keyValues) = (ident, union classes [c], keyValues)

1057+

1058+roleName :: RSTParser String

1059+roleName = many1 (letter <|> char '-')

10271060

10281061roleMarker :: RSTParser String

1029−roleMarker = char ':' *> roleNameEndingIn (char ':')

1062+roleMarker = char ':' *> roleName <* char ':'

10301063

10311064roleBefore :: RSTParser (String,String)

10321065roleBefore = try $ do

tests/Tests/Readers/RST.hs+37−18

@@ -67,26 +67,45 @@ tests = [ "line block with blank line" =:

6767 link "http://foo.bar.baz" "" "http://foo.bar.baz" <> ". " <>

6868 link "http://foo.bar/baz_(bam)" "" "http://foo.bar/baz_(bam)"

6969 <> " (" <> link "http://foo.bar" "" "http://foo.bar" <> ")")

70− , "indented literal block" =: unlines

71− [ "::"

72− , ""

73− , " block quotes"

74− , ""

75− , " can go on for many lines"

76− , "but must stop here"]

77− =?> (doc $

78− codeBlock "block quotes\n\ncan go on for many lines" <>

79− para "but must stop here")

80− , "line block with 3 lines" =: "| a\n| b\n| c"

81− =?> para ("a" <> linebreak <> "b" <> linebreak <> "c")

70+ , testGroup "literal / line / code blocks"

71+ [ "indented literal block" =: unlines

72+ [ "::"

73+ , ""

74+ , " block quotes"

75+ , ""

76+ , " can go on for many lines"

77+ , "but must stop here"]

78+ =?> (doc $

79+ codeBlock "block quotes\n\ncan go on for many lines" <>

80+ para "but must stop here")

81+ , "line block with 3 lines" =: "| a\n| b\n| c"

82+ =?> para ("a" <> linebreak <> "b" <> linebreak <> "c")

8283 , "quoted literal block using >" =: "::\n\n> quoted\n> block\n\nOrdinary paragraph"

8384 =?> codeBlock "> quoted\n> block" <> para "Ordinary paragraph"

8485 , "quoted literal block using | (not a line block)" =: "::\n\n| quoted\n| block\n\nOrdinary paragraph"

8586 =?> codeBlock "| quoted\n| block" <> para "Ordinary paragraph"

86− , "class directive with single paragraph" =: ".. class:: special\n\nThis is a \"special\" paragraph."

87− =?> divWith ("", ["special"], []) (para "This is a \"special\" paragraph.")

88− , "class directive with two paragraphs" =: ".. class:: exceptional remarkable\n\n First paragraph.\n\n Second paragraph."

89− =?> divWith ("", ["exceptional", "remarkable"], []) (para "First paragraph." <> para "Second paragraph.")

90− , "class directive around literal block" =: ".. class:: classy\n\n::\n\n a\n b"

91− =?> divWith ("", ["classy"], []) (codeBlock "a\nb")

87+ , "class directive with single paragraph" =: ".. class:: special\n\nThis is a \"special\" paragraph."

88+ =?> divWith ("", ["special"], []) (para "This is a \"special\" paragraph.")

89+ , "class directive with two paragraphs" =: ".. class:: exceptional remarkable\n\n First paragraph.\n\n Second paragraph."

90+ =?> divWith ("", ["exceptional", "remarkable"], []) (para "First paragraph." <> para "Second paragraph.")

91+ , "class directive around literal block" =: ".. class:: classy\n\n::\n\n a\n b"

92+ =?> divWith ("", ["classy"], []) (codeBlock "a\nb")]

93+ , testGroup "interpreted text roles"

94+ [ "literal role prefix" =: ":literal:`a`" =?> para (code "a")

95+ , "literal role postfix" =: "`a`:literal:" =?> para (code "a")

96+ , "literal text" =: "``text``" =?> para (code "text")

97+ , "code role" =: ":code:`a`" =?> para (codeWith ("", ["sourceCode"], []) "a")

98+ , "inherited code role" =: ".. role:: codeLike(code)\n\n:codeLike:`a`"

99+ =?> para (codeWith ("", ["codeLike", "sourceCode"], []) "a")

100+ , "custom code role with language field"

101+ =: ".. role:: lhs(code)\n :language: haskell\n\n:lhs:`a`"

102+ =?> para (codeWith ("", ["lhs", "haskell","sourceCode"], []) "a")

103+ , "custom role with unspecified parent role"

104+ =: ".. role:: classy\n\n:classy:`text`"

105+ =?> para (spanWith ("", ["classy"], []) "text")

106+ , "role with recursive inheritance"

107+ =: ".. role:: haskell(code)\n.. role:: lhs(haskell)\n\n:lhs:`text`"

108+ =?> para (codeWith ("", ["lhs", "haskell", "sourceCode"], []) "text")

109+ , "unknown role" =: ":unknown:`text`" =?> para (str "text")

110+ ]

92111 ]

tests/rst-reader.native+3−3

@@ -322,12 +322,12 @@ Pandoc (Meta {unMeta = fromList [("author",MetaList [MetaInlines [Str "John",Spa

322322,Null

323323,Para [Str "And",Space,Str "now",Space,Str "with",Space,RawInline (Format "html") "<b>inline</b> <span id=\"test\">HTML</span>",Str "."]

324324,Null

325−,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["sourceCode","haskell"],[]) "fmap id [1,2..10]",Str "."]

325+,Para [Str "And",Space,Str "some",Space,Str "inline",Space,Str "haskell",Space,Code ("",["haskell","sourceCode"],[]) "fmap id [1,2..10]",Str "."]

326326,Null

327327,Null

328−,Para [Str "Indirect",Space,Str "python",Space,Str "role",Space,Code ("",["sourceCode","python"],[]) "[x*x for x in [1,2,3,4,5]]",Str "."]

328+,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 "."]

329329,Null

330330,Null

331−,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["sourceCode","c"],[]) "int x = 15;",Str "."]

331+,Para [Str "Different",Space,Str "indirect",Space,Str "C",Space,Code ("",["c","different-indirect","sourceCode"],[]) "int x = 15;",Str "."]

332332,Header 2 ("literal-symbols",[],[]) [Str "Literal",Space,Str "symbols"]

333333,Para [Str "2*2",Space,Str "=",Space,Str "4*1"]]