39e8b42 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: extract inline parser to module

39e8b42Albert Krewinkel10 years ago

pandoc.cabal+2

compare with master

unifiedsplit

@@ -393,6 +393,8 @@ Library

393 Text.Pandoc.Readers.Odt.Generic.XMLConverter,

394 Text.Pandoc.Readers.Odt.Arrows.State,

395 Text.Pandoc.Readers.Odt.Arrows.Utils,

396+ Text.Pandoc.Readers.Org.BlockStarts,

397+ Text.Pandoc.Readers.Org.Inlines,

396 Text.Pandoc.Readers.Org.ParserState,

398 Text.Pandoc.Readers.Org.ParserState,

397 Text.Pandoc.Readers.Org.Parsing,

399 Text.Pandoc.Readers.Org.Parsing,

398 Text.Pandoc.Writers.Shared,

400 Text.Pandoc.Writers.Shared,

src/Text/Pandoc/Readers/Org.hs+41−756

@@ -1,5 +1,4 @@

1{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE OverloadedStrings #-}

3{-

2{-

@@ -29,6 +28,8 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.

29-}

28-}

30module Text.Pandoc.Readers.Org ( readOrg ) where

29module Text.Pandoc.Readers.Org ( readOrg ) where

31+import Text.Pandoc.Readers.Org.BlockStarts

32+import Text.Pandoc.Readers.Org.Inlines

32import Text.Pandoc.Readers.Org.ParserState

33import Text.Pandoc.Readers.Org.ParserState

33import Text.Pandoc.Readers.Org.Parsing

34import Text.Pandoc.Readers.Org.Parsing

@@ -38,19 +39,16 @@ import Text.Pandoc.Definition

38import Text.Pandoc.Compat.Monoid ((<>))

39import Text.Pandoc.Compat.Monoid ((<>))

39import Text.Pandoc.Error

40import Text.Pandoc.Error

40import Text.Pandoc.Options

41import Text.Pandoc.Options

41−import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)

42−import Text.Pandoc.Shared (compactify', compactify'DL)

42+import Text.Pandoc.Shared ( compactify', compactify'DL )

43−import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

44−import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

46−import Control.Arrow (first)

44+import Control.Arrow ( first )

47−import Control.Monad (foldM, guard, mplus, mzero, when)

45+import Control.Monad ( foldM, guard, mzero )

48import Control.Monad.Reader ( runReader )

46import Control.Monad.Reader ( runReader )

49−import Data.Char (isAlphaNum, isSpace, toLower, toUpper)

47+import Data.Char ( toLower, toUpper)

50−import Data.List ( foldl', intersperse, isPrefixOf, isSuffixOf )

48+import Data.List ( foldl', intersperse, isPrefixOf )

51import qualified Data.Map as M

49import qualified Data.Map as M

52import Data.Maybe ( fromMaybe, isNothing )

50import Data.Maybe ( fromMaybe, isNothing )

53−import Network.HTTP (urlEncode)

51+import Network.HTTP ( urlEncode )

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

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

@@ -59,54 +57,6 @@ readOrg :: ReaderOptions -- ^ Reader options

59 -> Either PandocError Pandoc

57 -> Either PandocError Pandoc

60readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

58readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

62−--

63−-- Functions acting on the parser state

64−--

65−recordAnchorId :: String -> OrgParser ()

66−recordAnchorId i = updateState $ \s ->

67− s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

68−

69−pushToInlineCharStack :: Char -> OrgParser ()

70−pushToInlineCharStack c = updateState $ \s ->

71− s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }

72−

73−popInlineCharStack :: OrgParser ()

74−popInlineCharStack = updateState $ \s ->

75− s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }

76−

77−surroundingEmphasisChar :: OrgParser [Char]

78−surroundingEmphasisChar =

79− take 1 . drop 1 . orgStateEmphasisCharStack <$> getState

80−

81−startEmphasisNewlinesCounting :: Int -> OrgParser ()

82−startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->

83− s{ orgStateEmphasisNewlines = Just maxNewlines }

84−

85−decEmphasisNewlinesCount :: OrgParser ()

86−decEmphasisNewlinesCount = updateState $ \s ->

87− s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }

88−

89−newlinesCountWithinLimits :: OrgParser Bool

90−newlinesCountWithinLimits = do

91− st <- getState

92− return $ ((< 0) <$> orgStateEmphasisNewlines st) /= Just True

93−

94−resetEmphasisNewlines :: OrgParser ()

95−resetEmphasisNewlines = updateState $ \s ->

96− s{ orgStateEmphasisNewlines = Nothing }

97−

98−addLinkFormat :: String

99− -> (String -> String)

100− -> OrgParser ()

101−addLinkFormat key formatter = updateState $ \s ->

102− let fs = orgStateLinkFormatters s

103− in s{ orgStateLinkFormatters = M.insert key formatter fs }

104−

105−addToNotesTable :: OrgNoteRecord -> OrgParser ()

106−addToNotesTable note = do

107− oldnotes <- orgStateNotes' <$> getState

108− updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

109−

110--

60--

111-- Export Settings

61-- Export Settings

112--

62--

@@ -259,7 +209,7 @@ block = choice [ mempty <$ blanklines

259 , genericDrawer

209 , genericDrawer

260 , specialLine

210 , specialLine

261 , header

211 , header

262− , return <$> hline

212+ , horizontalRule

263 , list

213 , list

264 , latexFragment

214 , latexFragment

265 , noteBlock

215 , noteBlock

@@ -457,9 +407,6 @@ indentWith num = do

457

407

458type SwitchOption = (Char, Maybe String)

408type SwitchOption = (Char, Maybe String)

459

409

460−orgArgWord :: OrgParser String

461−orgArgWord = many1 orgArgWordChar

462−

463-- | Parse code block arguments

410-- | Parse code block arguments

464-- TODO: We currently don't handle switches.

411-- TODO: We currently don't handle switches.

465codeHeaderArgs :: OrgParser ([String], [(String, String)])

412codeHeaderArgs :: OrgParser ([String], [(String, String)])

@@ -474,7 +421,10 @@ codeHeaderArgs = try $ do

474 , map toRundocAttrib (("language", language) : parameters)

421 , map toRundocAttrib (("language", language) : parameters)

475 )

422 )

476 else ([ pandocLang ], parameters)

423 else ([ pandocLang ], parameters)

424+ where

477− where hasRundocParameters = not . null

425+ hasRundocParameters = not . null

426+ toRundocAttrib = first ("rundoc-" ++)

427+

478

428

479switch :: OrgParser SwitchOption

429switch :: OrgParser SwitchOption

480switch = try $ simpleSwitch <|> lineNumbersSwitch

430switch = try $ simpleSwitch <|> lineNumbersSwitch

@@ -508,17 +458,6 @@ blockOption = try $ do

508 paramValue <- option "yes" orgParamValue

458 paramValue <- option "yes" orgParamValue

509 return (argKey, paramValue)

459 return (argKey, paramValue)

510

460

511−inlineBlockOption :: OrgParser (String, String)

512−inlineBlockOption = try $ do

513− argKey <- orgArgKey

514− paramValue <- option "yes" orgInlineParamValue

515− return (argKey, paramValue)

516−

517−orgArgKey :: OrgParser String

518−orgArgKey = try $

519− skipSpaces *> char ':'

520− *> many1 orgArgWordChar

521−

522orgParamValue :: OrgParser String

461orgParamValue :: OrgParser String

523orgParamValue = try $

462orgParamValue = try $

524 skipSpaces

463 skipSpaces

@@ -526,19 +465,6 @@ orgParamValue = try $

526 *> many1 (noneOf "\t\n\r ")

465 *> many1 (noneOf "\t\n\r ")

527 <* skipSpaces

466 <* skipSpaces

528

467

529−orgInlineParamValue :: OrgParser String

530−orgInlineParamValue = try $

531− skipSpaces

532− *> notFollowedBy (char ':')

533− *> many1 (noneOf "\t\n\r ]")

534− <* skipSpaces

535−

536−orgArgWordChar :: OrgParser Char

537−orgArgWordChar = alphaNum <|> oneOf "-_"

538−

539−toRundocAttrib :: (String, String) -> (String, String)

540−toRundocAttrib = first ("rundoc-" ++)

541−

542commaEscaped :: String -> String

468commaEscaped :: String -> String

543commaEscaped (',':cs@('*':_)) = cs

469commaEscaped (',':cs@('*':_)) = cs

544commaEscaped (',':cs@('#':'+':_)) = cs

470commaEscaped (',':cs@('#':'+':_)) = cs

@@ -552,7 +478,10 @@ exampleCode :: String -> Blocks

552exampleCode = B.codeBlockWith ("", ["example"], [])

478exampleCode = B.codeBlockWith ("", ["example"], [])

553

479

554exampleLine :: OrgParser String

480exampleLine :: OrgParser String

555−exampleLine = try $ skipSpaces *> string ": " *> anyLine

481+exampleLine = try $ exampleLineStart *> anyLine

482+

483+horizontalRule :: OrgParser (F Blocks)

484+horizontalRule = return B.horizontalRule <$ try hline

556

485

557

486

558--

487--

@@ -582,11 +511,6 @@ genericDrawer = try $ do

582 drawerDiv :: String -> F Blocks -> F Blocks

511 drawerDiv :: String -> F Blocks -> F Blocks

583 drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)

512 drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)

584

513

585−drawerStart :: OrgParser String

586−drawerStart = try $

587− skipSpaces *> drawerName <* skipSpaces <* newline

588− where drawerName = char ':' *> manyTill nonspaceChar (char ':')

589−

590drawerLine :: OrgParser String

514drawerLine :: OrgParser String

591drawerLine = anyLine

515drawerLine = anyLine

592

516

@@ -639,31 +563,38 @@ figure = try $ do

639 let attr = (mempty, mempty, figKeyVals)

563 let attr = (mempty, mempty, figKeyVals)

640 return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)

564 return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)

641 where

565 where

566+ withFigPrefix :: String -> String

642 withFigPrefix cs =

567 withFigPrefix cs =

643 if "fig:" `isPrefixOf` cs

568 if "fig:" `isPrefixOf` cs

644 then cs

569 then cs

645 else "fig:" ++ cs

570 else "fig:" ++ cs

646

571

572+ selfTarget :: OrgParser String

573+ selfTarget = try $ char '[' *> linkTarget <* char ']'

574+

575+

647--

576--

648-- Comments, Options and Metadata

577-- Comments, Options and Metadata

649--

578--

579+

580+addLinkFormat :: String

581+ -> (String -> String)

582+ -> OrgParser ()

583+addLinkFormat key formatter = updateState $ \s ->

584+ let fs = orgStateLinkFormatters s

585+ in s{ orgStateLinkFormatters = M.insert key formatter fs }

586+

650specialLine :: OrgParser (F Blocks)

587specialLine :: OrgParser (F Blocks)

651specialLine = fmap return . try $ metaLine <|> commentLine

588specialLine = fmap return . try $ metaLine <|> commentLine

652

589

653−metaLine :: OrgParser Blocks

654−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

655−

656-- The order, in which blocks are tried, makes sure that we're not looking at

590-- The order, in which blocks are tried, makes sure that we're not looking at

657-- the beginning of a block, so we don't need to check for it

591-- the beginning of a block, so we don't need to check for it

658−metaLineStart :: OrgParser ()

592+metaLine :: OrgParser Blocks

659−metaLineStart = try $ skipSpaces <* string "#+"

593+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

660

594

661commentLine :: OrgParser Blocks

595commentLine :: OrgParser Blocks

662commentLine = commentLineStart *> anyLine *> pure mempty

596commentLine = commentLineStart *> anyLine *> pure mempty

663

597

664−commentLineStart :: OrgParser ()

665−commentLineStart = try $ skipSpaces <* string "# "

666−

667declarationLine :: OrgParser ()

598declarationLine :: OrgParser ()

668declarationLine = try $ do

599declarationLine = try $ do

669 key <- metaKey

600 key <- metaKey

@@ -741,23 +672,6 @@ header = try $ do

741 *> many1 tag

672 *> many1 tag

742 <* skipSpaces

673 <* skipSpaces

743

674

744−headerStart :: OrgParser Int

745−headerStart = try $

746− (length <$> many1 (char '*')) <* many1 (char ' ') <* updateLastPreCharPos

747−

748−

749−-- Don't use (or need) the reader wrapper here, we want hline to be

750−-- @show@able. Otherwise we can't use it with @notFollowedBy'@.

751−

752−-- | Horizontal Line (five -- dashes or more)

753−hline :: OrgParser Blocks

754−hline = try $ do

755− skipSpaces

756− string "-----"

757− many (char '-')

758− skipSpaces

759− newline

760− return B.horizontalRule

761

675

762--

676--

763-- Tables

677-- Tables

@@ -793,9 +707,6 @@ orgToPandocTable :: OrgTable

793orgToPandocTable (OrgTable aligns heads lns) caption =

707orgToPandocTable (OrgTable aligns heads lns) caption =

794 B.table caption (zip aligns $ repeat 0) heads lns

708 B.table caption (zip aligns $ repeat 0) heads lns

795

709

796−tableStart :: OrgParser Char

797−tableStart = try $ skipSpaces *> char '|'

798−

799tableRows :: OrgParser [OrgTableRow]

710tableRows :: OrgParser [OrgTableRow]

800tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

711tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

801

712

@@ -899,25 +810,12 @@ latexFragment = try $ do

899 , "\\end{", e, "}\n"

810 , "\\end{", e, "}\n"

900 ]

811 ]

901

812

902−latexEnvStart :: OrgParser String

903−latexEnvStart = try $ do

904− skipSpaces *> string "\\begin{"

905− *> latexEnvName

906− <* string "}"

907− <* blankline

908−

909latexEnd :: String -> OrgParser ()

813latexEnd :: String -> OrgParser ()

910latexEnd envName = try $

814latexEnd envName = try $

911 () <$ skipSpaces

815 () <$ skipSpaces

912 <* string ("\\end{" ++ envName ++ "}")

816 <* string ("\\end{" ++ envName ++ "}")

913 <* blankline

817 <* blankline

914

818

915−-- | Parses a LaTeX environment name.

916−latexEnvName :: OrgParser String

917−latexEnvName = try $ do

918− mappend <$> many1 alphaNum

919− <*> option "" (string "*")

920−

921

819

922--

820--

923-- Footnote defintions

821-- Footnote defintions

@@ -942,7 +840,7 @@ paraOrPlain = try $ do

942 -- is directly followed by a list item, in which case the block is read as

840 -- is directly followed by a list item, in which case the block is read as

943 -- plain text.

841 -- plain text.

944 try (guard nl

842 try (guard nl

945− *> notFollowedBy (inList *> (orderedListStart <|> bulletListStart))

843+ *> notFollowedBy (inList *> (() <$ orderedListStart <|> bulletListStart))

946 *> return (B.para <$> ils))

844 *> return (B.para <$> ils))

947 <|> (return (B.plain <$> ils))

845 <|> (return (B.plain <$> ils))

948

846

@@ -971,38 +869,21 @@ orderedList :: OrgParser (F Blocks)

971orderedList = fmap B.orderedList . fmap compactify' . sequence

869orderedList = fmap B.orderedList . fmap compactify' . sequence

972 <$> many1 (listItem orderedListStart)

870 <$> many1 (listItem orderedListStart)

973

871

974−genericListStart :: OrgParser String

975− -> OrgParser Int

976−genericListStart listMarker = try $

977− (+) <$> (length <$> many spaceChar)

978− <*> (length <$> listMarker <* many1 spaceChar)

979−

980−-- parses bullet list marker. maybe we know the indent level

981−bulletListStart :: OrgParser Int

982−bulletListStart = bulletListStart' Nothing

983−

984bulletListStart' :: Maybe Int -> OrgParser Int

872bulletListStart' :: Maybe Int -> OrgParser Int

985-- returns length of bulletList prefix, inclusive of marker

873-- returns length of bulletList prefix, inclusive of marker

986bulletListStart' Nothing = do ind <- length <$> many spaceChar

874bulletListStart' Nothing = do ind <- length <$> many spaceChar

987− when (ind == 0) $ notFollowedBy (char '*')

875+ oneOf (bullets $ ind == 0)

988− oneOf bullets

876+ skipSpaces1

989− many1 spaceChar

990 return (ind + 1)

877 return (ind + 1)

991− -- Unindented lists are legal, but they can't use '*' bullets

992− -- We return n to maintain compatibility with the generic listItem

993bulletListStart' (Just n) = do count (n-1) spaceChar

878bulletListStart' (Just n) = do count (n-1) spaceChar

994− when (n == 1) $ notFollowedBy (char '*')

879+ oneOf (bullets $ n == 1)

995− oneOf bullets

996 many1 spaceChar

880 many1 spaceChar

997 return n

881 return n

998

882

883+-- Unindented lists are legal, but they can't use '*' bullets.

884+-- We return n to maintain compatibility with the generic listItem.

999−bullets :: String

885+bullets :: Bool -> String

1000−bullets = "*+-"

886+bullets unindented = if unindented then "+-" else "*+-"

1001−

1002−orderedListStart :: OrgParser Int

1003−orderedListStart = genericListStart orderedListMarker

1004− -- Ordered list markers allowed in org-mode

1005− where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")

1006

887

1007definitionListItem :: OrgParser Int

888definitionListItem :: OrgParser Int

1008 -> OrgParser (F (Inlines, [Blocks]))

889 -> OrgParser (F (Inlines, [Blocks]))

@@ -1040,602 +921,6 @@ listContinuation markerLength = try $

1040 <*> many blankline)

921 <*> many blankline)

1041 where listLine = try $ indentWith markerLength *> anyLineNewline

922 where listLine = try $ indentWith markerLength *> anyLineNewline

1042

923

924+-- | Parse any line, include the final newline in the output.

1043anyLineNewline :: OrgParser String

925anyLineNewline :: OrgParser String

1044anyLineNewline = (++ "\n") <$> anyLine

926anyLineNewline = (++ "\n") <$> anyLine

1045−

1046−

1047−--

1048−-- inline

1049−--

1050−

1051−inline :: OrgParser (F Inlines)

1052−inline =

1053− choice [ whitespace

1054− , linebreak

1055− , cite

1056− , footnote

1057− , linkOrImage

1058− , anchor

1059− , inlineCodeBlock

1060− , str

1061− , endline

1062− , emph

1063− , strong

1064− , strikeout

1065− , underline

1066− , code

1067− , math

1068− , displayMath

1069− , verbatim

1070− , subscript

1071− , superscript

1072− , inlineLaTeX

1073− , smart

1074− , symbol

1075− ] <* (guard =<< newlinesCountWithinLimits)

1076− <?> "inline"

1077−

1078−parseInlines :: OrgParser (F Inlines)

1079−parseInlines = trimInlinesF . mconcat <$> many1 inline

1080−

1081−-- treat these as potentially non-text when parsing inline:

1082−specialChars :: [Char]

1083−specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"

1084−

1085−

1086−whitespace :: OrgParser (F Inlines)

1087−whitespace = pure B.space <$ skipMany1 spaceChar

1088− <* updateLastPreCharPos

1089− <* updateLastForbiddenCharPos

1090− <?> "whitespace"

1091−

1092−linebreak :: OrgParser (F Inlines)

1093−linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline

1094−

1095−str :: OrgParser (F Inlines)

1096−str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")

1097− <* updateLastStrPos

1098−

1099−-- | An endline character that can be treated as a space, not a structural

1100−-- break. This should reflect the values of the Emacs variable

1101−-- @org-element-pagaraph-separate@.

1102−endline :: OrgParser (F Inlines)

1103−endline = try $ do

1104− newline

1105− notFollowedBy blankline

1106− notFollowedBy' exampleLine

1107− notFollowedBy' hline

1108− notFollowedBy' noteMarker

1109− notFollowedBy' tableStart

1110− notFollowedBy' drawerStart

1111− notFollowedBy' headerStart

1112− notFollowedBy' metaLineStart

1113− notFollowedBy' latexEnvStart

1114− notFollowedBy' commentLineStart

1115− notFollowedBy' bulletListStart

1116− notFollowedBy' orderedListStart

1117− decEmphasisNewlinesCount

1118− guard =<< newlinesCountWithinLimits

1119− updateLastPreCharPos

1120− return . return $ B.softbreak

1121−

1122−cite :: OrgParser (F Inlines)

1123−cite = try $ do

1124− guardEnabled Ext_citations

1125− (cs, raw) <- withRaw normalCite

1126− return $ (flip B.cite (B.text raw)) <$> cs

1127−

1128−normalCite :: OrgParser (F [Citation])

1129−normalCite = try $ char '['

1130− *> skipSpaces

1131− *> citeList

1132− <* skipSpaces

1133− <* char ']'

1134−

1135−citeList :: OrgParser (F [Citation])

1136−citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)

1137−

1138−citation :: OrgParser (F Citation)

1139−citation = try $ do

1140− pref <- prefix

1141− (suppress_author, key) <- citeKey

1142− suff <- suffix

1143− return $ do

1144− x <- pref

1145− y <- suff

1146− return $ Citation{ citationId = key

1147− , citationPrefix = B.toList x

1148− , citationSuffix = B.toList y

1149− , citationMode = if suppress_author

1150− then SuppressAuthor

1151− else NormalCitation

1152− , citationNoteNum = 0

1153− , citationHash = 0

1154− }

1155− where

1156− prefix = trimInlinesF . mconcat <$>

1157− manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))

1158− suffix = try $ do

1159− hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1160− skipSpaces

1161− rest <- trimInlinesF . mconcat <$>

1162− many (notFollowedBy (oneOf ";]") *> inline)

1163− return $ if hasSpace

1164− then (B.space <>) <$> rest

1165− else rest

1166−

1167−footnote :: OrgParser (F Inlines)

1168−footnote = try $ inlineNote <|> referencedNote

1169−

1170−inlineNote :: OrgParser (F Inlines)

1171−inlineNote = try $ do

1172− string "[fn:"

1173− ref <- many alphaNum

1174− char ':'

1175− note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')

1176− when (not $ null ref) $

1177− addToNotesTable ("fn:" ++ ref, note)

1178− return $ B.note <$> note

1179−

1180−referencedNote :: OrgParser (F Inlines)

1181−referencedNote = try $ do

1182− ref <- noteMarker

1183− return $ do

1184− notes <- asksF orgStateNotes'

1185− case lookup ref notes of

1186− Nothing -> return $ B.str $ "[" ++ ref ++ "]"

1187− Just contents -> do

1188− st <- askF

1189− let contents' = runF contents st{ orgStateNotes' = [] }

1190− return $ B.note contents'

1191−

1192−noteMarker :: OrgParser String

1193−noteMarker = try $ do

1194− char '['

1195− choice [ many1Till digit (char ']')

1196− , (++) <$> string "fn:"

1197− <*> many1Till (noneOf "\n\r\t ") (char ']')

1198− ]

1199−

1200−linkOrImage :: OrgParser (F Inlines)

1201−linkOrImage = explicitOrImageLink

1202− <|> selflinkOrImage

1203− <|> angleLink

1204− <|> plainLink

1205− <?> "link or image"

1206−

1207−explicitOrImageLink :: OrgParser (F Inlines)

1208−explicitOrImageLink = try $ do

1209− char '['

1210− srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

1211− title <- enclosedRaw (char '[') (char ']')

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

1213− char ']'

1214− return $ do

1215− src <- srcF

1216− if isImageFilename title

1217− then pure $ B.link src "" $ B.image title mempty mempty

1218− else linkToInlinesF src =<< title'

1219−

1220−selflinkOrImage :: OrgParser (F Inlines)

1221−selflinkOrImage = try $ do

1222− src <- char '[' *> linkTarget <* char ']'

1223− return $ linkToInlinesF src (B.str src)

1224−

1225−plainLink :: OrgParser (F Inlines)

1226−plainLink = try $ do

1227− (orig, src) <- uri

1228− returnF $ B.link src "" (B.str orig)

1229−

1230−angleLink :: OrgParser (F Inlines)

1231−angleLink = try $ do

1232− char '<'

1233− link <- plainLink

1234− char '>'

1235− return link

1236−

1237−selfTarget :: OrgParser String

1238−selfTarget = try $ char '[' *> linkTarget <* char ']'

1239−

1240−linkTarget :: OrgParser String

1241−linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

1242−

1243−possiblyEmptyLinkTarget :: OrgParser String

1244−possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")

1245−

1246−applyCustomLinkFormat :: String -> OrgParser (F String)

1247−applyCustomLinkFormat link = do

1248− let (linkType, rest) = break (== ':') link

1249− return $ do

1250− formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters

1251− return $ maybe link ($ drop 1 rest) formatter

1252−

1253−-- | Take a link and return a function which produces new inlines when given

1254−-- description inlines.

1255−linkToInlinesF :: String -> Inlines -> F Inlines

1256−linkToInlinesF linkStr =

1257− case linkStr of

1258− "" -> pure . B.link mempty "" -- wiki link (empty by convention)

1259− ('#':_) -> pure . B.link linkStr "" -- document-local fraction

1260− _ -> case cleanLinkString linkStr of

1261− (Just cleanedLink) -> if isImageFilename cleanedLink

1262− then const . pure $ B.image cleanedLink "" ""

1263− else pure . B.link cleanedLink ""

1264− Nothing -> internalLink linkStr -- other internal link

1265−

1266−-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

1267−-- the string does not appear to be a link.

1268−cleanLinkString :: String -> Maybe String

1269−cleanLinkString s =

1270− case s of

1271− '/':_ -> Just $ "file://" ++ s -- absolute path

1272− '.':'/':_ -> Just s -- relative path

1273− '.':'.':'/':_ -> Just s -- relative path

1274− -- Relative path or URL (file schema)

1275− 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

1276− _ | isUrl s -> Just s -- URL

1277− _ -> Nothing

1278− where

1279− isUrl :: String -> Bool

1280− isUrl cs =

1281− let (scheme, path) = break (== ':') cs

1282− in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

1283− && not (null path)

1284−

1285−isImageFilename :: String -> Bool

1286−isImageFilename filename =

1287− any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

1288− (any (\x -> (x++":") `isPrefixOf` filename) protocols ||

1289− ':' `notElem` filename)

1290− where

1291− imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

1292− protocols = [ "file", "http", "https" ]

1293−

1294−internalLink :: String -> Inlines -> F Inlines

1295−internalLink link title = do

1296− anchorB <- (link `elem`) <$> asksF orgStateAnchorIds

1297− if anchorB

1298− then return $ B.link ('#':link) "" title

1299− else return $ B.emph title

1300−

1301−-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with

1302−-- @anchor-id@ set as id. Legal anchors in org-mode are defined through

1303−-- @org-target-regexp@, which is fairly liberal. Since no link is created if

1304−-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as

1305−-- an anchor.

1306−

1307−anchor :: OrgParser (F Inlines)

1308−anchor = try $ do

1309− anchorId <- parseAnchor

1310− recordAnchorId anchorId

1311− returnF $ B.spanWith (solidify anchorId, [], []) mempty

1312− where

1313− parseAnchor = string "<<"

1314− *> many1 (noneOf "\t\n\r<>\"' ")

1315− <* string ">>"

1316− <* skipSpaces

1317−

1318−-- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors

1319−-- the org function @org-export-solidify-link-text@.

1320−

1321−solidify :: String -> String

1322−solidify = map replaceSpecialChar

1323− where replaceSpecialChar c

1324− | isAlphaNum c = c

1325− | c `elem` ("_.-:" :: String) = c

1326− | otherwise = '-'

1327−

1328−-- | Parses an inline code block and marks it as an babel block.

1329−inlineCodeBlock :: OrgParser (F Inlines)

1330−inlineCodeBlock = try $ do

1331− string "src_"

1332− lang <- many1 orgArgWordChar

1333− opts <- option [] $ enclosedByPair '[' ']' inlineBlockOption

1334− inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")

1335− let attrClasses = [translateLang lang, rundocBlockClass]

1336− let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

1337− returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1338−

1339−enclosedByPair :: Char -- ^ opening char

1340− -> Char -- ^ closing char

1341− -> OrgParser a -- ^ parser

1342− -> OrgParser [a]

1343−enclosedByPair s e p = char s *> many1Till p (char e)

1344−

1345−emph :: OrgParser (F Inlines)

1346−emph = fmap B.emph <$> emphasisBetween '/'

1347−

1348−strong :: OrgParser (F Inlines)

1349−strong = fmap B.strong <$> emphasisBetween '*'

1350−

1351−strikeout :: OrgParser (F Inlines)

1352−strikeout = fmap B.strikeout <$> emphasisBetween '+'

1353−

1354−-- There is no underline, so we use strong instead.

1355−underline :: OrgParser (F Inlines)

1356−underline = fmap B.strong <$> emphasisBetween '_'

1357−

1358−verbatim :: OrgParser (F Inlines)

1359−verbatim = return . B.code <$> verbatimBetween '='

1360−

1361−code :: OrgParser (F Inlines)

1362−code = return . B.code <$> verbatimBetween '~'

1363−

1364−subscript :: OrgParser (F Inlines)

1365−subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)

1366−

1367−superscript :: OrgParser (F Inlines)

1368−superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)

1369−

1370−math :: OrgParser (F Inlines)

1371−math = return . B.math <$> choice [ math1CharBetween '$'

1372− , mathStringBetween '$'

1373− , rawMathBetween "\$" "\$"

1374− ]

1375−

1376−displayMath :: OrgParser (F Inlines)

1377−displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

1378− , rawMathBetween "$$" "$$"

1379− ]

1380−

1381−updatePositions :: Char

1382− -> OrgParser (Char)

1383−updatePositions c = do

1384− when (c `elem` emphasisPreChars) updateLastPreCharPos

1385− when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1386− return c

1387−

1388−symbol :: OrgParser (F Inlines)

1389−symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

1390−

1391−emphasisBetween :: Char

1392− -> OrgParser (F Inlines)

1393−emphasisBetween c = try $ do

1394− startEmphasisNewlinesCounting emphasisAllowedNewlines

1395− res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

1396− isTopLevelEmphasis <- null . orgStateEmphasisCharStack <$> getState

1397− when isTopLevelEmphasis

1398− resetEmphasisNewlines

1399− return res

1400−

1401−verbatimBetween :: Char

1402− -> OrgParser String

1403−verbatimBetween c = try $

1404− emphasisStart c *>

1405− many1TillNOrLessNewlines 1 (noneOf "\n\r") (emphasisEnd c)

1406−

1407−-- | Parses a raw string delimited by @c@ using Org's math rules

1408−mathStringBetween :: Char

1409− -> OrgParser String

1410−mathStringBetween c = try $ do

1411− mathStart c

1412− body <- many1TillNOrLessNewlines mathAllowedNewlines

1413− (noneOf (c:"\n\r"))

1414− (lookAhead $ mathEnd c)

1415− final <- mathEnd c

1416− return $ body ++ [final]

1417−

1418−-- | Parse a single character between @c@ using math rules

1419−math1CharBetween :: Char

1420− -> OrgParser String

1421−math1CharBetween c = try $ do

1422− char c

1423− res <- noneOf $ c:mathForbiddenBorderChars

1424− char c

1425− eof <|> () <$ lookAhead (oneOf mathPostChars)

1426− return [res]

1427−

1428−rawMathBetween :: String

1429− -> String

1430− -> OrgParser String

1431−rawMathBetween s e = try $ string s *> manyTill anyChar (try $ string e)

1432−

1433−-- | Parses the start (opening character) of emphasis

1434−emphasisStart :: Char -> OrgParser Char

1435−emphasisStart c = try $ do

1436− guard =<< afterEmphasisPreChar

1437− guard =<< notAfterString

1438− char c

1439− lookAhead (noneOf emphasisForbiddenBorderChars)

1440− pushToInlineCharStack c

1441− return c

1442−

1443−-- | Parses the closing character of emphasis

1444−emphasisEnd :: Char -> OrgParser Char

1445−emphasisEnd c = try $ do

1446− guard =<< notAfterForbiddenBorderChar

1447− char c

1448− eof <|> () <$ lookAhead acceptablePostChars

1449− updateLastStrPos

1450− popInlineCharStack

1451− return c

1452− where acceptablePostChars =

1453− surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)

1454−

1455−mathStart :: Char -> OrgParser Char

1456−mathStart c = try $

1457− char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))

1458−

1459−mathEnd :: Char -> OrgParser Char

1460−mathEnd c = try $ do

1461− res <- noneOf (c:mathForbiddenBorderChars)

1462− char c

1463− eof <|> () <$ lookAhead (oneOf mathPostChars)

1464− return res

1465−

1466−

1467−enclosedInlines :: OrgParser a

1468− -> OrgParser b

1469− -> OrgParser (F Inlines)

1470−enclosedInlines start end = try $

1471− trimInlinesF . mconcat <$> enclosed start end inline

1472−

1473−enclosedRaw :: OrgParser a

1474− -> OrgParser b

1475− -> OrgParser String

1476−enclosedRaw start end = try $

1477− start *> (onSingleLine <|> spanningTwoLines)

1478− where onSingleLine = try $ many1Till (noneOf "\n\r") end

1479− spanningTwoLines = try $

1480− anyLine >>= \f -> mappend (f <> " ") <$> onSingleLine

1481−

1482−-- | Like many1Till, but parses at most @n+1@ lines. @p@ must not consume

1483−-- newlines.

1484−many1TillNOrLessNewlines :: Int

1485− -> OrgParser Char

1486− -> OrgParser a

1487− -> OrgParser String

1488−many1TillNOrLessNewlines n p end = try $

1489− nMoreLines (Just n) mempty >>= oneOrMore

1490− where

1491− nMoreLines Nothing cs = return cs

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

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

1494− >>= uncurry nMoreLines

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

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

1497− finalLine = try $ manyTill p end

1498− minus1 k = k - 1

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

1500−

1501−-- Org allows customization of the way it reads emphasis. We use the defaults

1502−-- here (see, e.g., the Emacs Lisp variable `org-emphasis-regexp-components`

1503−-- for details).

1504−

1505−-- | Chars allowed to occur before emphasis (spaces and newlines are ok, too)

1506−emphasisPreChars :: [Char]

1507−emphasisPreChars = "\t \"'({"

1508−

1509−-- | Chars allowed at after emphasis

1510−emphasisPostChars :: [Char]

1511−emphasisPostChars = "\t\n !\"'),-.:;?\\}"

1512−

1513−-- | Chars not allowed at the (inner) border of emphasis

1514−emphasisForbiddenBorderChars :: [Char]

1515−emphasisForbiddenBorderChars = "\t\n\r \"',"

1516−

1517−-- | The maximum number of newlines within

1518−emphasisAllowedNewlines :: Int

1519−emphasisAllowedNewlines = 1

1520−

1521−-- LaTeX-style math: see `org-latex-regexps` for details

1522−

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

1524−mathPostChars :: [Char]

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

1526−

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

1528−mathForbiddenBorderChars :: [Char]

1529−mathForbiddenBorderChars = "\t\n\r ,;.$"

1530−

1531−-- | Maximum number of newlines in an inline math statement

1532−mathAllowedNewlines :: Int

1533−mathAllowedNewlines = 2

1534−

1535−-- | Whether we are right behind a char allowed before emphasis

1536−afterEmphasisPreChar :: OrgParser Bool

1537−afterEmphasisPreChar = do

1538− pos <- getPosition

1539− lastPrePos <- orgStateLastPreCharPos <$> getState

1540− return . fromMaybe True $ (== pos) <$> lastPrePos

1541−

1542−-- | Whether the parser is right after a forbidden border char

1543−notAfterForbiddenBorderChar :: OrgParser Bool

1544−notAfterForbiddenBorderChar = do

1545− pos <- getPosition

1546− lastFBCPos <- orgStateLastForbiddenCharPos <$> getState

1547− return $ lastFBCPos /= Just pos

1548−

1549−-- | Read a sub- or superscript expression

1550−subOrSuperExpr :: OrgParser (F Inlines)

1551−subOrSuperExpr = try $

1552− choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")

1553− , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")

1554− , simpleSubOrSuperString

1555− ] >>= parseFromString (mconcat <$> many inline)

1556− where enclosing (left, right) s = left : s ++ [right]

1557−

1558−simpleSubOrSuperString :: OrgParser String

1559−simpleSubOrSuperString = try $ do

1560− state <- getState

1561− guard . exportSubSuperscripts . orgStateExportSettings $ state

1562− choice [ string "*"

1563− , mappend <$> option [] ((:[]) <$> oneOf "+-")

1564− <*> many1 alphaNum

1565− ]

1566−

1567−inlineLaTeX :: OrgParser (F Inlines)

1568−inlineLaTeX = try $ do

1569− cmd <- inlineLaTeXCommand

1570− maybe mzero returnF $

1571− parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

1572− where

1573− parseAsMath :: String -> Maybe Inlines

1574− parseAsMath cs = B.fromList <$> texMathToPandoc cs

1575−

1576− parseAsInlineLaTeX :: String -> Maybe Inlines

1577− parseAsInlineLaTeX cs = maybeRight $ runParser inlineCommand state "" cs

1578−

1579− parseAsMathMLSym :: String -> Maybe Inlines

1580− parseAsMathMLSym cs = B.str <$> MathMLEntityMap.getUnicode (clean cs)

1581− -- drop initial backslash and any trailing "{}"

1582− where clean = dropWhileEnd (`elem` ("{}" :: String)) . drop 1

1583−

1584− state :: ParserState

1585− state = def{ stateOptions = def{ readerParseRaw = True }}

1586−

1587− texMathToPandoc :: String -> Maybe [Inline]

1588− texMathToPandoc cs = (maybeRight $ readTeX cs) >>= writePandoc DisplayInline

1589−

1590−maybeRight :: Either a b -> Maybe b

1591−maybeRight = either (const Nothing) Just

1592−

1593−inlineLaTeXCommand :: OrgParser String

1594−inlineLaTeXCommand = try $ do

1595− rest <- getInput

1596− case runParser rawLaTeXInline def "source" rest of

1597− Right (RawInline _ cs) -> do

1598− -- drop any trailing whitespace, those are not be part of the command as

1599− -- far as org mode is concerned.

1600− let cmdNoSpc = dropWhileEnd isSpace cs

1601− let len = length cmdNoSpc

1602− count len anyChar

1603− return cmdNoSpc

1604− _ -> mzero

1605−

1606−-- Taken from Data.OldList.

1607−dropWhileEnd :: (a -> Bool) -> [a] -> [a]

1608−dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []

1609−

1610−smart :: OrgParser (F Inlines)

1611−smart = do

1612− getOption readerSmart >>= guard

1613− doubleQuoted <|> singleQuoted <|>

1614− choice (map (return <$>) [orgApostrophe, orgDash, orgEllipses])

1615− where

1616− orgDash = dash <* updatePositions '-'

1617− orgEllipses = ellipses <* updatePositions '.'

1618− orgApostrophe =

1619− (char '\'' <|> char '\8217') <* updateLastPreCharPos

1620− <* updateLastForbiddenCharPos

1621− *> return (B.str "\x2019")

1622−

1623−singleQuoted :: OrgParser (F Inlines)

1624−singleQuoted = try $ do

1625− singleQuoteStart

1626− updatePositions '\''

1627− withQuoteContext InSingleQuote $

1628− fmap B.singleQuoted . trimInlinesF . mconcat <$>

1629− many1Till inline (singleQuoteEnd <* updatePositions '\'')

1630−

1631−-- doubleQuoted will handle regular double-quoted sections, as well

1632−-- as dialogues with an open double-quote without a close double-quote

1633−-- in the same paragraph.

1634−doubleQuoted :: OrgParser (F Inlines)

1635−doubleQuoted = try $ do

1636− doubleQuoteStart

1637− updatePositions '"'

1638− contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1639− (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

1640− (fmap B.doubleQuoted . trimInlinesF $ contents))

1641− <|> (return $ return (B.str "\8220") <> contents)

src/Text/Pandoc/Readers/Org/BlockStarts.hsnew file+112

@@ -0,0 +1,112 @@

1+{-

4+This program is free software; you can redistribute it and/or modify

5+it under the terms of the GNU General Public License as published by

6+the Free Software Foundation; either version 2 of the License, or

7+(at your option) any later version.

9+This program is distributed in the hope that it will be useful,

10+but WITHOUT ANY WARRANTY; without even the implied warranty of

11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

12+GNU General Public License for more details.

13+

14+You should have received a copy of the GNU General Public License

15+along with this program; if not, write to the Free Software

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

17+-}

18+

19+{- |

20+ Module : Text.Pandoc.Readers.Org.Options

22+ License : GNU GPL, version 2 or above

23+

24+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

25+

26+Parsers for Org-mode inline elements.

27+-}

28+module Text.Pandoc.Readers.Org.BlockStarts

29+ ( exampleLineStart

30+ , hline

31+ , noteMarker

32+ , tableStart

33+ , drawerStart

34+ , headerStart

35+ , metaLineStart

36+ , latexEnvStart

37+ , commentLineStart

38+ , bulletListStart

39+ , orderedListStart

40+ ) where

41+

42+import Text.Pandoc.Readers.Org.Parsing

43+

44+-- | Horizontal Line (five -- dashes or more)

45+hline :: OrgParser ()

46+hline = try $ do

47+ skipSpaces

48+ string "-----"

49+ many (char '-')

50+ skipSpaces

51+ newline

52+ return ()

53+

54+-- | Read the start of a header line, return the header level

55+headerStart :: OrgParser Int

56+headerStart = try $

57+ (length <$> many1 (char '*')) <* many1 (char ' ') <* updateLastPreCharPos

58+

59+tableStart :: OrgParser Char

60+tableStart = try $ skipSpaces *> char '|'

61+

62+latexEnvStart :: OrgParser String

63+latexEnvStart = try $ do

64+ skipSpaces *> string "\\begin{"

65+ *> latexEnvName

66+ <* string "}"

67+ <* blankline

68+ where

69+ latexEnvName :: OrgParser String

70+ latexEnvName = try $ mappend <$> many1 alphaNum <*> option "" (string "*")

71+

72+

73+-- | Parses bullet list marker.

74+bulletListStart :: OrgParser ()

75+bulletListStart = try $

76+ choice

77+ [ () <$ skipSpaces <* oneOf "+-" <* skipSpaces1

78+ , () <$ skipSpaces1 <* char '*' <* skipSpaces1

79+ ]

80+

81+genericListStart :: OrgParser String

82+ -> OrgParser Int

83+genericListStart listMarker = try $

84+ (+) <$> (length <$> many spaceChar)

85+ <*> (length <$> listMarker <* many1 spaceChar)

86+

87+orderedListStart :: OrgParser Int

88+orderedListStart = genericListStart orderedListMarker

89+ -- Ordered list markers allowed in org-mode

90+ where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")

91+

92+drawerStart :: OrgParser String

93+drawerStart = try $

94+ skipSpaces *> drawerName <* skipSpaces <* newline

95+ where drawerName = char ':' *> manyTill nonspaceChar (char ':')

96+

97+metaLineStart :: OrgParser ()

98+metaLineStart = try $ skipSpaces <* string "#+"

99+

100+commentLineStart :: OrgParser ()

101+commentLineStart = try $ skipSpaces <* string "# "

102+

103+exampleLineStart :: OrgParser ()

104+exampleLineStart = () <$ try (skipSpaces *> string ": ")

105+

106+noteMarker :: OrgParser String

107+noteMarker = try $ do

108+ char '['

109+ choice [ many1Till digit (char ']')

110+ , (++) <$> string "fn:"

111+ <*> many1Till (noneOf "\n\r\t ") (char ']')

112+ ]

src/Text/Pandoc/Readers/Org/Inlines.hsnew file+715

@@ -0,0 +1,715 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-

5+This program is free software; you can redistribute it and/or modify

6+it under the terms of the GNU General Public License as published by

7+the Free Software Foundation; either version 2 of the License, or

8+(at your option) any later version.

10+This program is distributed in the hope that it will be useful,

11+but WITHOUT ANY WARRANTY; without even the implied warranty of

12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13+GNU General Public License for more details.

14+

15+You should have received a copy of the GNU General Public License

16+along with this program; if not, write to the Free Software

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

18+-}

19+

20+{- |

21+ Module : Text.Pandoc.Readers.Org.Options

23+ License : GNU GPL, version 2 or above

24+

25+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

26+

27+Parsers for Org-mode inline elements.

28+-}

29+module Text.Pandoc.Readers.Org.Inlines

30+ ( inline

31+ , addToNotesTable

32+ , parseInlines

33+ , isImageFilename

34+ , linkTarget

35+ ) where

36+

37+import Text.Pandoc.Readers.Org.BlockStarts

38+import Text.Pandoc.Readers.Org.ParserState

39+import Text.Pandoc.Readers.Org.Parsing

40+

41+import qualified Text.Pandoc.Builder as B

42+import Text.Pandoc.Builder ( Inlines )

43+import Text.Pandoc.Definition

44+import Text.Pandoc.Compat.Monoid ( (<>) )

45+import Text.Pandoc.Options

46+import Text.Pandoc.Readers.LaTeX ( inlineCommand, rawLaTeXInline )

47+import Text.TeXMath ( readTeX, writePandoc, DisplayType(..) )

48+import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

49+

50+import Control.Arrow ( first )

51+import Control.Monad ( guard, mplus, mzero, when )

52+import Data.Char ( isAlphaNum, isSpace )

53+import Data.List ( isPrefixOf, isSuffixOf )

54+import Data.Maybe ( fromMaybe )

55+import qualified Data.Map as M

56+

57+-- | Prefix used for Rundoc classes and arguments.

58+rundocPrefix :: String

59+rundocPrefix = "rundoc-"

60+

61+-- | The class-name used to mark rundoc blocks.

62+rundocBlockClass :: String

63+rundocBlockClass = rundocPrefix ++ "block"

64+

65+toRundocAttrib :: (String, String) -> (String, String)

66+toRundocAttrib = first ("rundoc-" ++)

67+

68+translateLang :: String -> String

69+translateLang "C" = "c"

70+translateLang "C++" = "cpp"

71+translateLang "emacs-lisp" = "commonlisp" -- emacs lisp is not supported

72+translateLang "js" = "javascript"

73+translateLang "lisp" = "commonlisp"

74+translateLang "R" = "r"

75+translateLang "sh" = "bash"

76+translateLang "sqlite" = "sql"

77+translateLang cs = cs

78+

79+--

80+-- Functions acting on the parser state

81+--

82+recordAnchorId :: String -> OrgParser ()

83+recordAnchorId i = updateState $ \s ->

84+ s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

85+

86+pushToInlineCharStack :: Char -> OrgParser ()

87+pushToInlineCharStack c = updateState $ \s ->

88+ s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }

89+

90+popInlineCharStack :: OrgParser ()

91+popInlineCharStack = updateState $ \s ->

92+ s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }

93+

94+surroundingEmphasisChar :: OrgParser [Char]

95+surroundingEmphasisChar =

96+ take 1 . drop 1 . orgStateEmphasisCharStack <$> getState

97+

98+startEmphasisNewlinesCounting :: Int -> OrgParser ()

99+startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->

100+ s{ orgStateEmphasisNewlines = Just maxNewlines }

101+

102+decEmphasisNewlinesCount :: OrgParser ()

103+decEmphasisNewlinesCount = updateState $ \s ->

104+ s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }

105+

106+newlinesCountWithinLimits :: OrgParser Bool

107+newlinesCountWithinLimits = do

108+ st <- getState

109+ return $ ((< 0) <$> orgStateEmphasisNewlines st) /= Just True

110+

111+resetEmphasisNewlines :: OrgParser ()

112+resetEmphasisNewlines = updateState $ \s ->

113+ s{ orgStateEmphasisNewlines = Nothing }

114+

115+addToNotesTable :: OrgNoteRecord -> OrgParser ()

116+addToNotesTable note = do

117+ oldnotes <- orgStateNotes' <$> getState

118+ updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

119+

120+-- | Parse a single Org-mode inline element

121+inline :: OrgParser (F Inlines)

122+inline =

123+ choice [ whitespace

124+ , linebreak

125+ , cite

126+ , footnote

127+ , linkOrImage

128+ , anchor

129+ , inlineCodeBlock

130+ , str

131+ , endline

132+ , emph

133+ , strong

134+ , strikeout

135+ , underline

136+ , code

137+ , math

138+ , displayMath

139+ , verbatim

140+ , subscript

141+ , superscript

142+ , inlineLaTeX

143+ , smart

144+ , symbol

145+ ] <* (guard =<< newlinesCountWithinLimits)

146+ <?> "inline"

147+

148+parseInlines :: OrgParser (F Inlines)

149+parseInlines = trimInlinesF . mconcat <$> many1 inline

150+

151+-- treat these as potentially non-text when parsing inline:

152+specialChars :: [Char]

153+specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"

154+

155+

156+whitespace :: OrgParser (F Inlines)

157+whitespace = pure B.space <$ skipMany1 spaceChar

158+ <* updateLastPreCharPos

159+ <* updateLastForbiddenCharPos

160+ <?> "whitespace"

161+

162+linebreak :: OrgParser (F Inlines)

163+linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline

164+

165+str :: OrgParser (F Inlines)

166+str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")

167+ <* updateLastStrPos

168+

169+-- | An endline character that can be treated as a space, not a structural

170+-- break. This should reflect the values of the Emacs variable

171+-- @org-element-pagaraph-separate@.

172+endline :: OrgParser (F Inlines)

173+endline = try $ do

174+ newline

175+ notFollowedBy blankline

176+ notFollowedBy' exampleLineStart

177+ notFollowedBy' hline

178+ notFollowedBy' noteMarker

179+ notFollowedBy' tableStart

180+ notFollowedBy' drawerStart

181+ notFollowedBy' headerStart

182+ notFollowedBy' metaLineStart

183+ notFollowedBy' latexEnvStart

184+ notFollowedBy' commentLineStart

185+ notFollowedBy' bulletListStart

186+ notFollowedBy' orderedListStart

187+ decEmphasisNewlinesCount

188+ guard =<< newlinesCountWithinLimits

189+ updateLastPreCharPos

190+ return . return $ B.softbreak

191+

192+cite :: OrgParser (F Inlines)

193+cite = try $ do

194+ guardEnabled Ext_citations

195+ (cs, raw) <- withRaw normalCite

196+ return $ (flip B.cite (B.text raw)) <$> cs

197+

198+normalCite :: OrgParser (F [Citation])

199+normalCite = try $ char '['

200+ *> skipSpaces

201+ *> citeList

202+ <* skipSpaces

203+ <* char ']'

204+

205+citeList :: OrgParser (F [Citation])

206+citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)

207+

208+citation :: OrgParser (F Citation)

209+citation = try $ do

210+ pref <- prefix

211+ (suppress_author, key) <- citeKey

212+ suff <- suffix

213+ return $ do

214+ x <- pref

215+ y <- suff

216+ return $ Citation{ citationId = key

217+ , citationPrefix = B.toList x

218+ , citationSuffix = B.toList y

219+ , citationMode = if suppress_author

220+ then SuppressAuthor

221+ else NormalCitation

222+ , citationNoteNum = 0

223+ , citationHash = 0

224+ }

225+ where

226+ prefix = trimInlinesF . mconcat <$>

227+ manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))

228+ suffix = try $ do

229+ hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

230+ skipSpaces

231+ rest <- trimInlinesF . mconcat <$>

232+ many (notFollowedBy (oneOf ";]") *> inline)

233+ return $ if hasSpace

234+ then (B.space <>) <$> rest

235+ else rest

236+

237+footnote :: OrgParser (F Inlines)

238+footnote = try $ inlineNote <|> referencedNote

239+

240+inlineNote :: OrgParser (F Inlines)

241+inlineNote = try $ do

242+ string "[fn:"

243+ ref <- many alphaNum

244+ char ':'

245+ note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')

246+ when (not $ null ref) $

247+ addToNotesTable ("fn:" ++ ref, note)

248+ return $ B.note <$> note

249+

250+referencedNote :: OrgParser (F Inlines)

251+referencedNote = try $ do

252+ ref <- noteMarker

253+ return $ do

254+ notes <- asksF orgStateNotes'

255+ case lookup ref notes of

256+ Nothing -> return $ B.str $ "[" ++ ref ++ "]"

257+ Just contents -> do

258+ st <- askF

259+ let contents' = runF contents st{ orgStateNotes' = [] }

260+ return $ B.note contents'

261+

262+linkOrImage :: OrgParser (F Inlines)

263+linkOrImage = explicitOrImageLink

264+ <|> selflinkOrImage

265+ <|> angleLink

266+ <|> plainLink

267+ <?> "link or image"

268+

269+explicitOrImageLink :: OrgParser (F Inlines)

270+explicitOrImageLink = try $ do

271+ char '['

272+ srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

273+ title <- enclosedRaw (char '[') (char ']')

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

275+ char ']'

276+ return $ do

277+ src <- srcF

278+ if isImageFilename title

279+ then pure $ B.link src "" $ B.image title mempty mempty

280+ else linkToInlinesF src =<< title'

281+

282+selflinkOrImage :: OrgParser (F Inlines)

283+selflinkOrImage = try $ do

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

285+ return $ linkToInlinesF src (B.str src)

286+

287+plainLink :: OrgParser (F Inlines)

288+plainLink = try $ do

289+ (orig, src) <- uri

290+ returnF $ B.link src "" (B.str orig)

291+

292+angleLink :: OrgParser (F Inlines)

293+angleLink = try $ do

294+ char '<'

295+ link <- plainLink

296+ char '>'

297+ return link

298+

299+linkTarget :: OrgParser String

300+linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

301+

302+possiblyEmptyLinkTarget :: OrgParser String

303+possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")

304+

305+applyCustomLinkFormat :: String -> OrgParser (F String)

306+applyCustomLinkFormat link = do

307+ let (linkType, rest) = break (== ':') link

308+ return $ do

309+ formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters

310+ return $ maybe link ($ drop 1 rest) formatter

311+

312+-- | Take a link and return a function which produces new inlines when given

313+-- description inlines.

314+linkToInlinesF :: String -> Inlines -> F Inlines

315+linkToInlinesF linkStr =

316+ case linkStr of

317+ "" -> pure . B.link mempty "" -- wiki link (empty by convention)

318+ ('#':_) -> pure . B.link linkStr "" -- document-local fraction

319+ _ -> case cleanLinkString linkStr of

320+ (Just cleanedLink) -> if isImageFilename cleanedLink

321+ then const . pure $ B.image cleanedLink "" ""

322+ else pure . B.link cleanedLink ""

323+ Nothing -> internalLink linkStr -- other internal link

324+

325+-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

326+-- the string does not appear to be a link.

327+cleanLinkString :: String -> Maybe String

328+cleanLinkString s =

329+ case s of

330+ '/':_ -> Just $ "file://" ++ s -- absolute path

331+ '.':'/':_ -> Just s -- relative path

332+ '.':'.':'/':_ -> Just s -- relative path

333+ -- Relative path or URL (file schema)

334+ 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

335+ _ | isUrl s -> Just s -- URL

336+ _ -> Nothing

337+ where

338+ isUrl :: String -> Bool

339+ isUrl cs =

340+ let (scheme, path) = break (== ':') cs

341+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

342+ && not (null path)

343+

344+isImageFilename :: String -> Bool

345+isImageFilename filename =

346+ any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

347+ (any (\x -> (x++":") `isPrefixOf` filename) protocols ||

348+ ':' `notElem` filename)

349+ where

350+ imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

351+ protocols = [ "file", "http", "https" ]

352+

353+internalLink :: String -> Inlines -> F Inlines

354+internalLink link title = do

355+ anchorB <- (link `elem`) <$> asksF orgStateAnchorIds

356+ if anchorB

357+ then return $ B.link ('#':link) "" title

358+ else return $ B.emph title

359+

360+-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with

361+-- @anchor-id@ set as id. Legal anchors in org-mode are defined through

362+-- @org-target-regexp@, which is fairly liberal. Since no link is created if

363+-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as

364+-- an anchor.

365+

366+anchor :: OrgParser (F Inlines)

367+anchor = try $ do

368+ anchorId <- parseAnchor

369+ recordAnchorId anchorId

370+ returnF $ B.spanWith (solidify anchorId, [], []) mempty

371+ where

372+ parseAnchor = string "<<"

373+ *> many1 (noneOf "\t\n\r<>\"' ")

374+ <* string ">>"

375+ <* skipSpaces

376+

377+-- | Replace every char but [a-zA-Z0-9_.-:] with a hypen '-'. This mirrors

378+-- the org function @org-export-solidify-link-text@.

379+

380+solidify :: String -> String

381+solidify = map replaceSpecialChar

382+ where replaceSpecialChar c

383+ | isAlphaNum c = c

384+ | c `elem` ("_.-:" :: String) = c

385+ | otherwise = '-'

386+

387+-- | Parses an inline code block and marks it as an babel block.

388+inlineCodeBlock :: OrgParser (F Inlines)

389+inlineCodeBlock = try $ do

390+ string "src_"

391+ lang <- many1 orgArgWordChar

392+ opts <- option [] $ enclosedByPair '[' ']' inlineBlockOption

393+ inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")

394+ let attrClasses = [translateLang lang, rundocBlockClass]

395+ let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

396+ returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

397+ where

398+ inlineBlockOption :: OrgParser (String, String)

399+ inlineBlockOption = try $ do

400+ argKey <- orgArgKey

401+ paramValue <- option "yes" orgInlineParamValue

402+ return (argKey, paramValue)

403+

404+ orgInlineParamValue :: OrgParser String

405+ orgInlineParamValue = try $

406+ skipSpaces

407+ *> notFollowedBy (char ':')

408+ *> many1 (noneOf "\t\n\r ]")

409+ <* skipSpaces

410+

411+

412+

413+enclosedByPair :: Char -- ^ opening char

414+ -> Char -- ^ closing char

415+ -> OrgParser a -- ^ parser

416+ -> OrgParser [a]

417+enclosedByPair s e p = char s *> many1Till p (char e)

418+

419+emph :: OrgParser (F Inlines)

420+emph = fmap B.emph <$> emphasisBetween '/'

421+

422+strong :: OrgParser (F Inlines)

423+strong = fmap B.strong <$> emphasisBetween '*'

424+

425+strikeout :: OrgParser (F Inlines)

426+strikeout = fmap B.strikeout <$> emphasisBetween '+'

427+

428+-- There is no underline, so we use strong instead.

429+underline :: OrgParser (F Inlines)

430+underline = fmap B.strong <$> emphasisBetween '_'

431+

432+verbatim :: OrgParser (F Inlines)

433+verbatim = return . B.code <$> verbatimBetween '='

434+

435+code :: OrgParser (F Inlines)

436+code = return . B.code <$> verbatimBetween '~'

437+

438+subscript :: OrgParser (F Inlines)

439+subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)

440+

441+superscript :: OrgParser (F Inlines)

442+superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)

443+

444+math :: OrgParser (F Inlines)

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

446+ , mathStringBetween '$'

447+ , rawMathBetween "\$" "\$"

448+ ]

449+

450+displayMath :: OrgParser (F Inlines)

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

452+ , rawMathBetween "$$" "$$"

453+ ]

454+

455+updatePositions :: Char

456+ -> OrgParser (Char)

457+updatePositions c = do

458+ when (c `elem` emphasisPreChars) updateLastPreCharPos

459+ when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

460+ return c

461+

462+symbol :: OrgParser (F Inlines)

463+symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

464+

465+emphasisBetween :: Char

466+ -> OrgParser (F Inlines)

467+emphasisBetween c = try $ do

468+ startEmphasisNewlinesCounting emphasisAllowedNewlines

469+ res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

470+ isTopLevelEmphasis <- null . orgStateEmphasisCharStack <$> getState

471+ when isTopLevelEmphasis

472+ resetEmphasisNewlines

473+ return res

474+

475+verbatimBetween :: Char

476+ -> OrgParser String

477+verbatimBetween c = try $

478+ emphasisStart c *>

479+ many1TillNOrLessNewlines 1 (noneOf "\n\r") (emphasisEnd c)

480+

481+-- | Parses a raw string delimited by @c@ using Org's math rules

482+mathStringBetween :: Char

483+ -> OrgParser String

484+mathStringBetween c = try $ do

485+ mathStart c

486+ body <- many1TillNOrLessNewlines mathAllowedNewlines

487+ (noneOf (c:"\n\r"))

488+ (lookAhead $ mathEnd c)

489+ final <- mathEnd c

490+ return $ body ++ [final]

491+

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

493+math1CharBetween :: Char

494+ -> OrgParser String

495+math1CharBetween c = try $ do

496+ char c

497+ res <- noneOf $ c:mathForbiddenBorderChars

498+ char c

499+ eof <|> () <$ lookAhead (oneOf mathPostChars)

500+ return [res]

501+

502+rawMathBetween :: String

503+ -> String

504+ -> OrgParser String

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

506+

507+-- | Parses the start (opening character) of emphasis

508+emphasisStart :: Char -> OrgParser Char

509+emphasisStart c = try $ do

510+ guard =<< afterEmphasisPreChar

511+ guard =<< notAfterString

512+ char c

513+ lookAhead (noneOf emphasisForbiddenBorderChars)

514+ pushToInlineCharStack c

515+ return c

516+

517+-- | Parses the closing character of emphasis

518+emphasisEnd :: Char -> OrgParser Char

519+emphasisEnd c = try $ do

520+ guard =<< notAfterForbiddenBorderChar

521+ char c

522+ eof <|> () <$ lookAhead acceptablePostChars

523+ updateLastStrPos

524+ popInlineCharStack

525+ return c

526+ where acceptablePostChars =

527+ surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)

528+

529+mathStart :: Char -> OrgParser Char

530+mathStart c = try $

531+ char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))

532+

533+mathEnd :: Char -> OrgParser Char

534+mathEnd c = try $ do

535+ res <- noneOf (c:mathForbiddenBorderChars)

536+ char c

537+ eof <|> () <$ lookAhead (oneOf mathPostChars)

538+ return res

539+

540+

541+enclosedInlines :: OrgParser a

542+ -> OrgParser b

543+ -> OrgParser (F Inlines)

544+enclosedInlines start end = try $

545+ trimInlinesF . mconcat <$> enclosed start end inline

546+

547+enclosedRaw :: OrgParser a

548+ -> OrgParser b

549+ -> OrgParser String

550+enclosedRaw start end = try $

551+ start *> (onSingleLine <|> spanningTwoLines)

552+ where onSingleLine = try $ many1Till (noneOf "\n\r") end

553+ spanningTwoLines = try $

554+ anyLine >>= \f -> mappend (f <> " ") <$> onSingleLine

555+

556+-- | Like many1Till, but parses at most @n+1@ lines. @p@ must not consume

557+-- newlines.

558+many1TillNOrLessNewlines :: Int

559+ -> OrgParser Char

560+ -> OrgParser a

561+ -> OrgParser String

562+many1TillNOrLessNewlines n p end = try $

563+ nMoreLines (Just n) mempty >>= oneOrMore

564+ where

565+ nMoreLines Nothing cs = return cs

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

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

568+ >>= uncurry nMoreLines

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

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

571+ finalLine = try $ manyTill p end

572+ minus1 k = k - 1

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

574+

575+-- Org allows customization of the way it reads emphasis. We use the defaults

576+-- here (see, e.g., the Emacs Lisp variable `org-emphasis-regexp-components`

577+-- for details).

578+

579+-- | Chars allowed to occur before emphasis (spaces and newlines are ok, too)

580+emphasisPreChars :: [Char]

581+emphasisPreChars = "\t \"'({"

582+

583+-- | Chars allowed at after emphasis

584+emphasisPostChars :: [Char]

585+emphasisPostChars = "\t\n !\"'),-.:;?\\}"

586+

587+-- | Chars not allowed at the (inner) border of emphasis

588+emphasisForbiddenBorderChars :: [Char]

589+emphasisForbiddenBorderChars = "\t\n\r \"',"

590+

591+-- | The maximum number of newlines within

592+emphasisAllowedNewlines :: Int

593+emphasisAllowedNewlines = 1

594+

595+-- LaTeX-style math: see `org-latex-regexps` for details

596+

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

598+mathPostChars :: [Char]

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

600+

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

602+mathForbiddenBorderChars :: [Char]

603+mathForbiddenBorderChars = "\t\n\r ,;.$"

604+

605+-- | Maximum number of newlines in an inline math statement

606+mathAllowedNewlines :: Int

607+mathAllowedNewlines = 2

608+

609+-- | Whether we are right behind a char allowed before emphasis

610+afterEmphasisPreChar :: OrgParser Bool

611+afterEmphasisPreChar = do

612+ pos <- getPosition

613+ lastPrePos <- orgStateLastPreCharPos <$> getState

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

615+

616+-- | Whether the parser is right after a forbidden border char

617+notAfterForbiddenBorderChar :: OrgParser Bool

618+notAfterForbiddenBorderChar = do

619+ pos <- getPosition

620+ lastFBCPos <- orgStateLastForbiddenCharPos <$> getState

621+ return $ lastFBCPos /= Just pos

622+

623+-- | Read a sub- or superscript expression

624+subOrSuperExpr :: OrgParser (F Inlines)

625+subOrSuperExpr = try $

626+ choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")

627+ , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")

628+ , simpleSubOrSuperString

629+ ] >>= parseFromString (mconcat <$> many inline)

630+ where enclosing (left, right) s = left : s ++ [right]

631+

632+simpleSubOrSuperString :: OrgParser String

633+simpleSubOrSuperString = try $ do

634+ state <- getState

635+ guard . exportSubSuperscripts . orgStateExportSettings $ state

636+ choice [ string "*"

637+ , mappend <$> option [] ((:[]) <$> oneOf "+-")

638+ <*> many1 alphaNum

639+ ]

640+

641+inlineLaTeX :: OrgParser (F Inlines)

642+inlineLaTeX = try $ do

643+ cmd <- inlineLaTeXCommand

644+ maybe mzero returnF $

645+ parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

646+ where

647+ parseAsMath :: String -> Maybe Inlines

648+ parseAsMath cs = B.fromList <$> texMathToPandoc cs

649+

650+ parseAsInlineLaTeX :: String -> Maybe Inlines

651+ parseAsInlineLaTeX cs = maybeRight $ runParser inlineCommand state "" cs

652+

653+ parseAsMathMLSym :: String -> Maybe Inlines

654+ parseAsMathMLSym cs = B.str <$> MathMLEntityMap.getUnicode (clean cs)

655+ -- drop initial backslash and any trailing "{}"

656+ where clean = dropWhileEnd (`elem` ("{}" :: String)) . drop 1

657+

658+ state :: ParserState

659+ state = def{ stateOptions = def{ readerParseRaw = True }}

660+

661+ texMathToPandoc :: String -> Maybe [Inline]

662+ texMathToPandoc cs = (maybeRight $ readTeX cs) >>= writePandoc DisplayInline

663+

664+maybeRight :: Either a b -> Maybe b

665+maybeRight = either (const Nothing) Just

666+

667+inlineLaTeXCommand :: OrgParser String

668+inlineLaTeXCommand = try $ do

669+ rest <- getInput

670+ case runParser rawLaTeXInline def "source" rest of

671+ Right (RawInline _ cs) -> do

672+ -- drop any trailing whitespace, those are not be part of the command as

673+ -- far as org mode is concerned.

674+ let cmdNoSpc = dropWhileEnd isSpace cs

675+ let len = length cmdNoSpc

676+ count len anyChar

677+ return cmdNoSpc

678+ _ -> mzero

679+

680+-- Taken from Data.OldList.

681+dropWhileEnd :: (a -> Bool) -> [a] -> [a]

682+dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []

683+

684+smart :: OrgParser (F Inlines)

685+smart = do

686+ getOption readerSmart >>= guard

687+ doubleQuoted <|> singleQuoted <|>

688+ choice (map (return <$>) [orgApostrophe, orgDash, orgEllipses])

689+ where

690+ orgDash = dash <* updatePositions '-'

691+ orgEllipses = ellipses <* updatePositions '.'

692+ orgApostrophe =

693+ (char '\'' <|> char '\8217') <* updateLastPreCharPos

694+ <* updateLastForbiddenCharPos

695+ *> return (B.str "\x2019")

696+

697+singleQuoted :: OrgParser (F Inlines)

698+singleQuoted = try $ do

699+ singleQuoteStart

700+ updatePositions '\''

701+ withQuoteContext InSingleQuote $

702+ fmap B.singleQuoted . trimInlinesF . mconcat <$>

703+ many1Till inline (singleQuoteEnd <* updatePositions '\'')

704+

705+-- doubleQuoted will handle regular double-quoted sections, as well

706+-- as dialogues with an open double-quote without a close double-quote

707+-- in the same paragraph.

708+doubleQuoted :: OrgParser (F Inlines)

709+doubleQuoted = try $ do

710+ doubleQuoteStart

711+ updatePositions '"'

712+ contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

713+ (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

714+ (fmap B.doubleQuoted . trimInlinesF $ contents))

715+ <|> (return $ return (B.str "\8220") <> contents)

src/Text/Pandoc/Readers/Org/Parsing.hs+19

@@ -34,10 +34,14 @@ module Text.Pandoc.Readers.Org.Parsing

34 , blanklines

35 , newline

36 , parseFromString

37+ , skipSpaces1

37 , inList

38 , inList

38 , withContext

39 , withContext

39 , updateLastForbiddenCharPos

40 , updateLastForbiddenCharPos

40 , updateLastPreCharPos

41 , updateLastPreCharPos

42+ , orgArgKey

43+ , orgArgWord

44+ , orgArgWordChar

41 -- * Re-exports from Text.Pandoc.Parser

45 -- * Re-exports from Text.Pandoc.Parser

42 , ParserContext (..)

46 , ParserContext (..)

43 , many1Till

47 , many1Till

@@ -133,6 +137,10 @@ parseFromString parser str' = do

133 updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }

137 updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }

134 return result

138 return result

135

139

140+-- | Skip one or more tab or space characters.

141+skipSpaces1 :: OrgParser ()

142+skipSpaces1 = skipMany1 spaceChar

143+

136-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

144-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

137newline :: OrgParser Char

145newline :: OrgParser Char

138newline =

146newline =

@@ -180,3 +188,14 @@ updateLastForbiddenCharPos = getPosition >>= \p ->

180updateLastPreCharPos :: OrgParser ()

188updateLastPreCharPos :: OrgParser ()

181updateLastPreCharPos = getPosition >>= \p ->

189updateLastPreCharPos = getPosition >>= \p ->

182 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}

190 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}

191+

192+orgArgKey :: OrgParser String

193+orgArgKey = try $

194+ skipSpaces *> char ':'

195+ *> many1 orgArgWordChar

196+

197+orgArgWord :: OrgParser String

198+orgArgWord = many1 orgArgWordChar

199+

200+orgArgWordChar :: OrgParser Char

201+orgArgWordChar = alphaNum <|> oneOf "-_"