7b11154 · typeable/pandoc

git.iko.soy/typeable/pandoc

textile reader improvements : better conformance to RedCloth Textile inlines

commit7b111542c0ef62802a65986b41829196510e5b3e authorpaul.rivier <paul.r.ml@gmail.com> dateTue 24 Apr 2012, 15:56 (14 years ago) parent411d54c

4 files changed+78−56

compare with master

unifiedsplit

src/Text/Pandoc/Parsing.hs+5 src/Text/Pandoc/Readers/Textile.hs+67−51 tests/textile-reader.native+3−3 tests/textile-reader.textile+3−2

src/Text/Pandoc/Parsing.hs+5

@@ -52,6 +52,7 @@ module Text.Pandoc.Parsing ( (>>~),

5252 failUnlessLHS,

5353 escaped,

5454 characterReference,

55+ updateLastStrPos,

5556 anyOrderedListMarker,

5657 orderedListMarker,

5758 charRef,

@@ -786,6 +787,10 @@ charOrRef cs =

786787 guard (c `elem` cs)

787788 return c)

788789

790+updateLastStrPos :: GenParser Char ParserState ()

791+updateLastStrPos = getPosition >>= \p ->

792+ updateState $ \s -> s{ stateLastStrPos = Just p }

793+

789794singleQuoteStart :: GenParser Char ParserState ()

790795singleQuoteStart = do

791796 failIfInQuoteContext InSingleQuote

src/Text/Pandoc/Readers/Textile.hs+67−51

@@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

1818

1919{- |

2020 Module : Text.Pandoc.Readers.Textile

2222 License : GNU GPL, version 2 or above

2323

2424 Maintainer : Paul Rivier <paul*rivier#demotera*com>

@@ -62,7 +62,7 @@ import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )

6262import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )

6363import Text.ParserCombinators.Parsec

6464import Text.HTML.TagSoup.Match

65−import Data.Char ( digitToInt, isLetter )

65+import Data.Char ( digitToInt, isUpper )

6666import Control.Monad ( guard, liftM )

6767import Control.Applicative ((<$>), (*>), (<*))

6868

@@ -74,14 +74,6 @@ readTextile state s =

7474 (readWith parseTextile) state{ stateOldDashes = True } (s ++ "\n\n")

7575

7676

77−--

78−-- Constants and data structure definitions

79−--

80−

81−-- | Special chars border strings parsing

82−specialChars :: [Char]

83−specialChars = "\\[]<>*#_@~-+^&,.;:!?|\"'%()="

84−

8577-- | Generate a Pandoc ADT from a textile document

8678parseTextile :: GenParser Char ParserState Pandoc

8779parseTextile = do

@@ -360,14 +352,8 @@ inlineParsers = [ autoLink

360352 , rawHtmlInline

361353 , rawLaTeXInline'

362354 , note

363− , simpleInline (string "??") (Cite [])

364− , simpleInline (string "**") Strong

365− , simpleInline (string "__") Emph

366− , simpleInline (char '*') Strong

367− , simpleInline (char '_') Emph

368− , simpleInline (char '-') Strikeout

369− , simpleInline (char '^') Superscript

370− , simpleInline (char '~') Subscript

355+ , try $ (char '[' *> inlineMarkup <* char ']')

356+ , inlineMarkup

371357 , link

372358 , image

373359 , mark

@@ -375,6 +361,18 @@ inlineParsers = [ autoLink

375361 , symbol

376362 ]

377363

364+-- | Inline markups

365+inlineMarkup :: GenParser Char ParserState Inline

366+inlineMarkup = choice [ simpleInline (string "??") (Cite [])

367+ , simpleInline (string "**") Strong

368+ , simpleInline (string "__") Emph

369+ , simpleInline (char '*') Strong

370+ , simpleInline (char '_') Emph

371+ , simpleInline (char '-') Strikeout

372+ , simpleInline (char '^') Superscript

373+ , simpleInline (char '~') Subscript

374+ ]

375+

378376-- | Trademark, registered, copyright

379377mark :: GenParser Char st Inline

380378mark = try $ char '(' >> (try tm <|> try reg <|> copy)

@@ -400,33 +398,49 @@ copy = do

400398

401399note :: GenParser Char ParserState Inline

402400note = try $ do

403− char '['

404− ref <- many1 digit

405− char ']'

406− state <- getState

407− let notes = stateNotes state

401+ ref <- (char '[' *> many1 digit <* char ']')

402+ notes <- stateNotes <$> getState

408403 case lookup ref notes of

409404 Nothing -> fail "note not found"

410405 Just raw -> liftM Note $ parseFromString parseBlocks raw

411406

407+-- | Special chars

408+markupChars :: [Char]

409+markupChars = "\\[]*#_@~-+^|%="

410+

411+-- | Break strings on following chars. Space tab and newline break for

412+-- inlines breaking. Open paren breaks for mark. Quote, dash and dot

413+-- break for smart punctuation. Punctuation breaks for regular

414+-- punctuation. Double quote breaks for named links. > and < break

415+-- for inline html.

416+stringBreakers :: [Char]

417+stringBreakers = " \t\n('-.,:!?;\"<>"

418+

419+wordBoundaries :: [Char]

420+wordBoundaries = markupChars ++ stringBreakers

421+

422+-- | Parse a hyphened sequence of words

423+hyphenedWords :: GenParser Char ParserState String

424+hyphenedWords = try $ do

425+ hd <- noneOf wordBoundaries

426+ tl <- many ( (noneOf wordBoundaries) <|>

427+ try (oneOf markupChars <* lookAhead (noneOf wordBoundaries) ) )

428+ let wd = hd:tl

429+ option wd $ try $

430+ (\r -> concat [wd, "-", r]) <$> (char '-' *> hyphenedWords)

431+

412432-- | Any string

413433str :: GenParser Char ParserState Inline

414434str = do

415− xs <- many1 (noneOf (specialChars ++ "\t\n "))

416− optional $ try $ do

417− lookAhead (char '(')

418− notFollowedBy' mark

419− getInput >>= setInput . (' ':) -- add space before acronym explanation

420− -- parse a following hyphen if followed by a letter

421− -- (this prevents unwanted interpretation as starting a strikeout section)

422− result <- option xs $ try $ do

423− char '-'

424− next <- lookAhead letter

425− guard $ isLetter (last xs) || isLetter next

426− return $ xs ++ "-"

427− pos <- getPosition

428− updateState $ \s -> s{ stateLastStrPos = Just pos }

429− return $ Str result

435+ baseStr <- hyphenedWords

436+ -- RedCloth compliance : if parsed word is uppercase and immediatly

437+ -- followed by parens, parens content is unconditionally word acronym

438+ fullStr <- option baseStr $ try $ do

439+ guard $ all isUpper baseStr

440+ acro <- enclosed (char '(') (char ')') anyChar

441+ return $ concat [baseStr, " (", acro, ")"]

442+ updateLastStrPos

443+ return $ Str fullStr

430444

431445-- | Textile allows HTML span infos, we discard them

432446htmlSpan :: GenParser Char ParserState Inline

@@ -477,34 +491,36 @@ image = try $ do

477491escapedInline :: GenParser Char ParserState Inline

478492escapedInline = escapedEqs <|> escapedTag

479493

480−-- | literal text escaped between == ... ==

481494escapedEqs :: GenParser Char ParserState Inline

482−escapedEqs = try $ do

483− string "=="

484− contents <- manyTill anyChar (try $ string "==")

485− return $ Str contents

495+escapedEqs = Str <$> (try $ surrounded (string "==") anyChar)

496+

497+-- -- | literal text escaped between == ... ==

498+-- escapedEqs :: GenParser Char ParserState Inline

499+-- escapedEqs = try $ do

500+-- string "=="

501+-- contents <- manyTill anyChar (try $ string "==")

502+-- return $ Str contents

486503

487504-- | literal text escaped btw <notextile> tags

488505escapedTag :: GenParser Char ParserState Inline

489−escapedTag = try $ Str <$> ( string "<notextile>" *>

490− manyTill anyChar (try $ string "</notextile>") )

506+escapedTag = try $ Str <$>

507+ enclosed (string "<notextile>") (string "</notextile>") anyChar

491508

492−-- | Any special symbol defined in specialChars

509+-- | Any special symbol defined in wordBoundaries

493510symbol :: GenParser Char ParserState Inline

494−symbol = Str . singleton <$> oneOf specialChars

511+symbol = Str . singleton <$> oneOf wordBoundaries

495512

496513-- | Inline code

497514code :: GenParser Char ParserState Inline

498515code = code1 <|> code2

499516

500517code1 :: GenParser Char ParserState Inline

501−code1 = surrounded (char '@') anyChar >>= return . Code nullAttr

518+code1 = Code nullAttr <$> surrounded (char '@') anyChar

502519

503520code2 :: GenParser Char ParserState Inline

504521code2 = do

505522 htmlTag (tagOpen (=="tt") null)

506− result' <- manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))

507− return $ Code nullAttr result'

523+ Code nullAttr <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))

508524

509525-- | Html / CSS attributes

510526attributes :: GenParser Char ParserState String

@@ -528,4 +544,4 @@ simpleInline border construct = surrounded border (inlineWithAttribute) >>=

528544

529545-- | Create a singleton list

530546singleton :: a -> [a]

531−singleton x = [x]

547+singleton x = [x]

tests/textile-reader.native+3−3

@@ -67,9 +67,9 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})

6767 ,([Str "beer"],

6868 [[Plain [Str "fresh",Space,Str "and",Space,Str "bitter"]]])]

6969,Header 1 [Str "Inline",Space,Str "Markup"]

70−,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str ".",LineBreak,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str ".",LineBreak,Str "A",Space,Link [Strong [Str "strong",Space,Str "link"]] ("http://www.foobar.com",""),Str "."]

70+,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str ".",LineBreak,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str ".",LineBreak,Str "Hyphenated-words-are-ok",Str ",",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "strange_underscore_notation",Str ".",LineBreak,Str "A",Space,Link [Strong [Str "strong",Space,Str "link"]] ("http://www.foobar.com",""),Str "."]

7171,Para [Emph [Strong [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em",Str "."]],LineBreak,Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Space,Str "and",Space,Emph [Strong [Str "that",Space,Str "one"]],Str ".",LineBreak,Strikeout [Str "This",Space,Str "is",Space,Str "strikeout",Space,Str "and",Space,Strong [Str "strong"]]]

72−,Para [Str "Superscripts",Str ":",Space,Str "a",Superscript [Str "bc"],Str "d",Space,Str "a",Superscript [Strong [Str "hello"]],Space,Str "a",Superscript [Str "hello",Space,Str "there"],Str ".",LineBreak,Str "Subscripts",Str ":",Space,Str "H",Subscript [Str "2"],Str "O",Str ",",Space,Str "H",Subscript [Str "23"],Str "O",Str ",",Space,Str "H",Subscript [Str "many",Space,Str "of",Space,Str "them"],Str "O",Str "."]

72+,Para [Str "Superscripts",Str ":",Space,Str "a",Superscript [Str "bc"],Str "d",Space,Str "a",Superscript [Strong [Str "hello"]],Space,Str "a",Superscript [Str "hello",Space,Str "there"],Str ".",LineBreak,Str "Subscripts",Str ":",Space,Subscript [Str "here"],Space,Str "H",Subscript [Str "2"],Str "O",Str ",",Space,Str "H",Subscript [Str "23"],Str "O",Str ",",Space,Str "H",Subscript [Str "many",Space,Str "of",Space,Str "them"],Str "O",Str "."]

7373,Para [Str "Dashes",Space,Str ":",Space,Str "How",Space,Str "cool",Space,Str "\8212",Space,Str "automatic",Space,Str "dashes",Str "."]

7474,Para [Str "Elipses",Space,Str ":",Space,Str "He",Space,Str "thought",Space,Str "and",Space,Str "thought",Space,Str "\8230",Space,Str "and",Space,Str "then",Space,Str "thought",Space,Str "some",Space,Str "more",Str "."]

7575,Para [Str "Quotes",Space,Str "and",Space,Str "apostrophes",Space,Str ":",Space,Quoted DoubleQuote [Str "I",Str "\8217",Str "d",Space,Str "like",Space,Str "to",Space,Str "thank",Space,Str "you"],Space,Str "for",Space,Str "example",Str "."]

@@ -144,7 +144,7 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})

144144,RawBlock "latex" "\\begin{itemize}\n \\item one\n \\item two\n\\end{itemize}"

145145,Para [Str "and",Space,Str "for",Space,RawInline "latex" "\\emph{inlines}",Str "."]

146146,Header 1 [Str "Acronyms",Space,Str "and",Space,Str "marks"]

147−,Para [Str "PBS",Space,Str "(",Str "Public",Space,Str "Broadcasting",Space,Str "System",Str ")"]

147+,Para [Str "PBS (Public Broadcasting System)"]

148148,Para [Str "Hi",Str "\8482"]

149149,Para [Str "Hi",Space,Str "\8482"]

150150,Para [Str "\174",Space,Str "Hi",Str "\174"]

tests/textile-reader.textile+3−2

@@ -115,14 +115,15 @@ h1. Inline Markup

115115

116116This is _emphasized_, and so __is this__.

117117This is *strong*, and so **is this**.

118+Hyphenated-words-are-ok, as well as strange_underscore_notation.

118119A "*strong link*":http://www.foobar.com.

119120

120121_*This is strong and em.*_

121122So is *_this_* word and __**that one**__.

122123-This is strikeout and *strong*-

123124

124−Superscripts: a^bc^d a^*hello*^ a^hello there^.

125−Subscripts: H~2~O, H~23~O, H~many of them~O.

125+Superscripts: a[^bc^]d a^*hello*^ a[^hello there^].

126+Subscripts: ~here~ H[~2~]O, H[~23~]O, H[~many of them~]O.

126127

127128Dashes : How cool -- automatic dashes.

128129