3e14719 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1229 from tarleb/org-math-improved

3e14719John MacFarlane13 years ago

src/Text/Pandoc/Readers/Org.hs+50−22

compare with master

unifiedsplit

@@ -44,11 +44,14 @@ import Data.List (foldl', isPrefixOf, isSuffixOf)

44import Data.Maybe (listToMaybe, fromMaybe)

45import Data.Monoid (mconcat, mempty, mappend)

47+-- Ignore HLint warnings to use String instead of [Char]

48+{-# ANN module ("HLint: ignore Use String" :: String) #-}

49+

47-- | Parse org-mode string and return a Pandoc document.

50-- | Parse org-mode string and return a Pandoc document.

48readOrg :: ReaderOptions -- ^ Reader options

51readOrg :: ReaderOptions -- ^ Reader options

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

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

50 -> Pandoc

53 -> Pandoc

51−readOrg opts s = (readWith parseOrg) def{ orgStateOptions = opts } (s ++ "\n\n")

54+readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

53type OrgParser = Parser [Char] OrgParserState

56type OrgParser = Parser [Char] OrgParserState

@@ -111,7 +114,7 @@ updateLastPreCharPos = getPosition >>= \p ->

111

114

112pushToInlineCharStack :: Char -> OrgParser ()

115pushToInlineCharStack :: Char -> OrgParser ()

113pushToInlineCharStack c = updateState $ \st ->

116pushToInlineCharStack c = updateState $ \st ->

114− st { orgStateEmphasisCharStack = c:(orgStateEmphasisCharStack st) }

117+ st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st }

115

118

116popInlineCharStack :: OrgParser ()

119popInlineCharStack :: OrgParser ()

117popInlineCharStack = updateState $ \st ->

120popInlineCharStack = updateState $ \st ->

@@ -176,7 +179,7 @@ orgBlock = try $ do

176 "comment" -> return mempty

179 "comment" -> return mempty

177 "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr

180 "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr

178 _ -> B.divWith ("", [blockType], [])

181 _ -> B.divWith ("", [blockType], [])

179− <$> (parseFromString parseBlocks blockStr)

182+ <$> parseFromString parseBlocks blockStr

180

183

181blockHeader :: OrgParser (Int, String, [String])

184blockHeader :: OrgParser (Int, String, [String])

182blockHeader = (,,) <$> blockIndent

185blockHeader = (,,) <$> blockIndent

@@ -199,7 +202,7 @@ rawBlockContent indent blockType =

199indentWith :: Int -> OrgParser String

202indentWith :: Int -> OrgParser String

200indentWith num = do

203indentWith num = do

201 tabStop <- getOption readerTabStop

204 tabStop <- getOption readerTabStop

202− if (num < tabStop)

205+ if num < tabStop

203 then count num (char ' ')

206 then count num (char ' ')

204 else choice [ try (count num (char ' '))

207 else choice [ try (count num (char ' '))

205 , try (char '\t' >> count (num - tabStop) (char ' ')) ]

208 , try (char '\t' >> count (num - tabStop) (char ' ')) ]

@@ -242,7 +245,7 @@ drawerStart = try $

242 <|> stringAnyCase "LOGBOOK"

245 <|> stringAnyCase "LOGBOOK"

243

246

244drawerLine :: OrgParser String

247drawerLine :: OrgParser String

245−drawerLine = try $ anyLine

248+drawerLine = try anyLine

246

249

247drawerEnd :: OrgParser String

250drawerEnd :: OrgParser String

248drawerEnd = try $

251drawerEnd = try $

@@ -276,7 +279,7 @@ declarationLine = try $ do

276metaValue :: OrgParser MetaValue

279metaValue :: OrgParser MetaValue

277metaValue = MetaInlines . B.toList . trimInlines <$> restOfLine

280metaValue = MetaInlines . B.toList . trimInlines <$> restOfLine

278

281

279−metaKey :: OrgParser [Char]

282+metaKey :: OrgParser String

280metaKey = map toLower <$> many1 (noneOf ": \n\r")

283metaKey = map toLower <$> many1 (noneOf ": \n\r")

281 <* char ':'

284 <* char ':'

282 <* skipSpaces

285 <* skipSpaces

@@ -350,7 +353,7 @@ tableAlignRow = try $

350

353

351tableAlignCell :: OrgParser Alignment

354tableAlignCell :: OrgParser Alignment

352tableAlignCell =

355tableAlignCell =

353− choice [ try $ emptyCell *> return (AlignDefault)

356+ choice [ try $ emptyCell *> return AlignDefault

354 , try $ skipSpaces

357 , try $ skipSpaces

355 *> char '<'

358 *> char '<'

356 *> tableAlignFromChar

359 *> tableAlignFromChar

@@ -381,8 +384,8 @@ normalizeTable (OrgTable cols aligns heads lns) =

381 let aligns' = fillColumns aligns AlignDefault

384 let aligns' = fillColumns aligns AlignDefault

382 heads' = if heads == mempty

385 heads' = if heads == mempty

383 then mempty

386 then mempty

384− else fillColumns heads (B.plain mempty)

387+ else fillColumns heads (B.plain mempty)

385− lns' = map (flip fillColumns (B.plain mempty)) lns

388+ lns' = map (`fillColumns` B.plain mempty) lns

386 fillColumns base padding = take cols $ base ++ repeat padding

389 fillColumns base padding = take cols $ base ++ repeat padding

387 in OrgTable cols aligns' heads' lns'

390 in OrgTable cols aligns' heads' lns'

388

391

@@ -512,6 +515,7 @@ inline =

512 , underline

515 , underline

513 , code

516 , code

514 , math

517 , math

518+ , displayMath

515 , verbatim

519 , verbatim

516 , subscript

520 , subscript

517 , superscript

521 , superscript

@@ -564,13 +568,14 @@ explicitOrImageLink = try $ do

564 title <- enclosedRaw (char '[') (char ']')

568 title <- enclosedRaw (char '[') (char ']')

565 title' <- parseFromString (mconcat <$> many inline) title

569 title' <- parseFromString (mconcat <$> many inline) title

566 char ']'

570 char ']'

571+ return . B.link src ""

567− return $ if (isImageFilename src) && (isImageFilename title)

572+ $ if isImageFilename src && isImageFilename title

568− then B.link src "" (B.image title "" "")

573+ then B.image title "" ""

569− else B.link src "" title'

574+ else title'

570

575

571selflinkOrImage :: OrgParser Inlines

576selflinkOrImage :: OrgParser Inlines

572selflinkOrImage = try $ do

577selflinkOrImage = try $ do

573− src <- (char '[') *> linkTarget <* char ']'

578+ src <- char '[' *> linkTarget <* char ']'

574 return $ if isImageFilename src

579 return $ if isImageFilename src

575 then B.image src "" ""

580 then B.image src "" ""

576 else B.link src "" (B.str src)

581 else B.link src "" (B.str src)

@@ -607,13 +612,21 @@ verbatim :: OrgParser Inlines

607verbatim = B.rawInline "" <$> verbatimBetween '~'

612verbatim = B.rawInline "" <$> verbatimBetween '~'

608

613

609math :: OrgParser Inlines

614math :: OrgParser Inlines

615+math = B.math <$> choice [ math1CharBetween '$'

610−math = B.math <$> mathStringBetween '$'

616+ , mathStringBetween '$'

617+ , rawMathBetween "\$" "\$"

618+ ]

619+

620+displayMath :: OrgParser Inlines

621+displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

622+ , rawMathBetween "$$" "$$"

623+ ]

611

624

612subscript :: OrgParser Inlines

625subscript :: OrgParser Inlines

613−subscript = B.subscript <$> (try $ char '_' *> maybeGroupedByBraces)

626+subscript = B.subscript <$> try (char '_' *> maybeGroupedByBraces)

614

627

615superscript :: OrgParser Inlines

628superscript :: OrgParser Inlines

616−superscript = B.superscript <$> (try $ char '^' *> maybeGroupedByBraces)

629+superscript = B.superscript <$> try (char '^' *> maybeGroupedByBraces)

617

630

618maybeGroupedByBraces :: OrgParser Inlines

631maybeGroupedByBraces :: OrgParser Inlines

619maybeGroupedByBraces = try $

632maybeGroupedByBraces = try $

@@ -655,6 +668,21 @@ mathStringBetween c = try $ do

655 final <- mathEnd c

668 final <- mathEnd c

656 return $ body ++ [final]

669 return $ body ++ [final]

657

670

671+-- | Parse a single character between @c@ using math rules

672+math1CharBetween :: Char

673+ -> OrgParser String

674+math1CharBetween c = try $ do

675+ char c

676+ res <- noneOf $ c:mathForbiddenBorderChars

677+ char c

678+ eof <|> lookAhead (oneOf mathPostChars) *> return ()

679+ return [res]

680+

681+rawMathBetween :: String

682+ -> String

683+ -> OrgParser String

684+rawMathBetween s e = try $ string s *> manyTill anyChar (try $ string e)

685+

658-- | Parses the start (opening character) of emphasis

686-- | Parses the start (opening character) of emphasis

659emphasisStart :: Char -> OrgParser Char

687emphasisStart :: Char -> OrgParser Char

660emphasisStart c = try $ do

688emphasisStart c = try $ do

@@ -678,14 +706,14 @@ emphasisEnd c = try $ do

678 return c

706 return c

679

707

680mathStart :: Char -> OrgParser Char

708mathStart :: Char -> OrgParser Char

681−mathStart c = try $ do

709+mathStart c = try $

682 char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))

710 char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))

683

711

684mathEnd :: Char -> OrgParser Char

712mathEnd :: Char -> OrgParser Char

685mathEnd c = try $ do

713mathEnd c = try $ do

686 res <- noneOf (c:mathForbiddenBorderChars)

714 res <- noneOf (c:mathForbiddenBorderChars)

687 char c

715 char c

688− eof <|> (lookAhead $ oneOf mathPostChars *> pure ())

716+ eof <|> lookAhead (oneOf mathPostChars *> pure ())

689 return res

717 return res

690

718

691

719

@@ -717,8 +745,8 @@ many1TillNOrLessNewlines n p end = try $

717 nMoreLines (Just 0) cs = try $ (cs ++) <$> finalLine

745 nMoreLines (Just 0) cs = try $ (cs ++) <$> finalLine

718 nMoreLines k cs = try $ (final k cs <|> rest k cs)

746 nMoreLines k cs = try $ (final k cs <|> rest k cs)

719 >>= uncurry nMoreLines

747 >>= uncurry nMoreLines

720− final _ cs = (\x -> (Nothing, cs ++ x)) <$> (try finalLine)

748+ final _ cs = (\x -> (Nothing, cs ++ x)) <$> try finalLine

721− rest m cs = (\x -> (minus1 <$> m, cs ++ x ++ "\n")) <$> (try $ manyTill p P.newline)

749+ rest m cs = (\x -> (minus1 <$> m, cs ++ x ++ "\n")) <$> try (manyTill p P.newline)

722 finalLine = try $ manyTill p end

750 finalLine = try $ manyTill p end

723 minus1 k = k - 1

751 minus1 k = k - 1

724 oneOrMore cs = guard (not $ null cs) *> return cs

752 oneOrMore cs = guard (not $ null cs) *> return cs

@@ -747,7 +775,7 @@ emphasisAllowedNewlines = 1

747

775

748-- | Chars allowed after an inline ($...$) math statement

776-- | Chars allowed after an inline ($...$) math statement

749mathPostChars :: [Char]

777mathPostChars :: [Char]

750−mathPostChars = "\t\n \"',-.:;?"

778+mathPostChars = "\t\n \"'),-.:;?"

751

779

752-- | Chars not allowed at the (inner) border of math

780-- | Chars not allowed at the (inner) border of math

753mathForbiddenBorderChars :: [Char]

781mathForbiddenBorderChars :: [Char]

@@ -762,7 +790,7 @@ afterEmphasisPreChar :: OrgParser Bool

762afterEmphasisPreChar = do

790afterEmphasisPreChar = do

763 pos <- getPosition

791 pos <- getPosition

764 lastPrePos <- orgStateLastPreCharPos <$> getState

792 lastPrePos <- orgStateLastPreCharPos <$> getState

765− return $ lastPrePos == Nothing || lastPrePos == Just pos

793+ return . fromMaybe True $ (== pos) <$> lastPrePos

766

794

767-- | Whether we are right after the end of a string

795-- | Whether we are right after the end of a string

768notAfterString :: OrgParser Bool

796notAfterString :: OrgParser Bool

tests/Tests/Readers/Org.hs+30−6

@@ -54,14 +54,26 @@ tests =

54 "=Robot.rock()=" =?>

55 para (code "Robot.rock()")

57− , "Math" =:

58− "$E=mc^2$" =?>

59− para (math "E=mc^2")

60−

61 , "Verbatim" =:

57 , "Verbatim" =:

62 "~word for word~" =?>

58 "~word for word~" =?>

63 para (rawInline "" "word for word")

59 para (rawInline "" "word for word")

61+ , "Math $..$" =:

62+ "$E=mc^2$" =?>

63+ para (math "E=mc^2")

64+

65+ , "Math $$..$$" =:

66+ "$$E=mc^2$$" =?>

67+ para (displayMath "E=mc^2")

68+

69+ , "Math \\[..\\]" =:

70+ "\\[E=ℎν\\]" =?>

71+ para (displayMath "E=ℎν")

72+

73+ , "Math \$..\$" =:

74+ "\$σ_x σ_p ≥ \\frac{ℏ}{2}\$" =?>

75+ para (math "σ_x σ_p ≥ \\frac{ℏ}{2}")

76+

65 , "Symbol" =:

77 , "Symbol" =:

66 "A * symbol" =?>

78 "A * symbol" =?>

67 para (str "A" <> space <> str "*" <> space <> "symbol")

79 para (str "A" <> space <> str "*" <> space <> "symbol")

@@ -86,14 +98,19 @@ tests =

86 unlines [ "this+that+ +so+on"

98 unlines [ "this+that+ +so+on"

87 , "seven*eight* nine*"

99 , "seven*eight* nine*"

88 , "+not+funny+"

100 , "+not+funny+"

89− , "this == self"

90 ] =?>

101 ] =?>

91 para (spcSep [ "this+that+", "+so+on"

102 para (spcSep [ "this+that+", "+so+on"

92 , "seven*eight*", "nine*"

103 , "seven*eight*", "nine*"

93 , strikeout "not+funny"

104 , strikeout "not+funny"

94− , "this" <> space <> "==" <> space <> "self"

95 ])

105 ])

106

107+ , "No empty markup" =:

108+ -- FIXME: __ is erroneously parsed as subscript "_"

109+ -- "// ** __ ++ == ~~ $$" =?>

110+ -- para (spcSep [ "//", "**", "__", "++", "==", "~~", "$$" ])

111+ "// ** ++ == ~~ $$" =?>

112+ para (spcSep [ "//", "**", "++", "==", "~~", "$$" ])

113+

97 , "Adherence to Org's rules for markup borders" =:

114 , "Adherence to Org's rules for markup borders" =:

98 "/t/& a/ / ./r/ (*l*) /e/! /b/." =?>

115 "/t/& a/ / ./r/ (*l*) /e/! /b/." =?>

99 para (spcSep [ emph $ "t/&" <> space <> "a"

116 para (spcSep [ emph $ "t/&" <> space <> "a"

@@ -109,6 +126,13 @@ tests =

109 para ((math "a\nb\nc") <> space <>

126 para ((math "a\nb\nc") <> space <>

110 spcSep [ "$d", "e", "f", "g$" ])

127 spcSep [ "$d", "e", "f", "g$" ])

111

128

129+ , "Single-character math" =:

130+ "$a$ $b$! $c$?" =?>

131+ para (spcSep [ math "a"

132+ , "$b$!"

133+ , (math "c") <> "?"

134+ ])

135+

112 , "Markup may not span more than two lines" =:

136 , "Markup may not span more than two lines" =:

113 unlines [ "/this *is +totally", "nice+ not*", "emph/" ] =?>

137 unlines [ "/this *is +totally", "nice+ not*", "emph/" ] =?>

114 para (spcSep [ "/this"

138 para (spcSep [ "/this"