@@ -1,5 +1,4 @@
11{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE OverloadedStrings #-}
32{-
43Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
54
@@ -29,6 +28,8 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.
2928-}
3029module Text.Pandoc.Readers.Org ( readOrg ) where
3130
31+import Text.Pandoc.Readers.Org.BlockStarts
32+import Text.Pandoc.Readers.Org.Inlines
3233import Text.Pandoc.Readers.Org.ParserState
3334import Text.Pandoc.Readers.Org.Parsing
3435
@@ -38,19 +39,16 @@ import Text.Pandoc.Definition
3839import Text.Pandoc.Compat.Monoid ((<>))
3940import Text.Pandoc.Error
4041import Text.Pandoc.Options
41−import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
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
42+import Text.Pandoc.Shared ( compactify', compactify'DL )
4543
46−import Control.Arrow (first)
47−import Control.Monad (foldM, guard, mplus, mzero, when)
44+import Control.Arrow ( first )
45+import Control.Monad ( foldM, guard, mzero )
4846import Control.Monad.Reader ( runReader )
49−import Data.Char (isAlphaNum, isSpace, toLower, toUpper)
50−import Data.List ( foldl', intersperse, isPrefixOf, isSuffixOf )
47+import Data.Char ( toLower, toUpper)
48+import Data.List ( foldl', intersperse, isPrefixOf )
5149import qualified Data.Map as M
5250import Data.Maybe ( fromMaybe, isNothing )
53−import Network.HTTP (urlEncode)
51+import Network.HTTP ( urlEncode )
5452
5553
5654-- | Parse org-mode string and return a Pandoc document.
@@ -59,54 +57,6 @@ readOrg :: ReaderOptions -- ^ Reader options
5957 -> Either PandocError Pandoc
6058readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
6159
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−
11060--
11161-- Export Settings
11262--
@@ -259,7 +209,7 @@ block = choice [ mempty <$ blanklines
259209 , genericDrawer
260210 , specialLine
261211 , header
262− , return <$> hline
212+ , horizontalRule
263213 , list
264214 , latexFragment
265215 , noteBlock
@@ -457,9 +407,6 @@ indentWith num = do
457407
458408type SwitchOption = (Char, Maybe String)
459409
460−orgArgWord :: OrgParser String
461−orgArgWord = many1 orgArgWordChar
462−
463410-- | Parse code block arguments
464411-- TODO: We currently don't handle switches.
465412codeHeaderArgs :: OrgParser ([String], [(String, String)])
@@ -474,7 +421,10 @@ codeHeaderArgs = try $ do
474421 , map toRundocAttrib (("language", language) : parameters)
475422 )
476423 else ([ pandocLang ], parameters)
477− where hasRundocParameters = not . null
424+ where
425+ hasRundocParameters = not . null
426+ toRundocAttrib = first ("rundoc-" ++)
427+
478428
479429switch :: OrgParser SwitchOption
480430switch = try $ simpleSwitch <|> lineNumbersSwitch
@@ -508,17 +458,6 @@ blockOption = try $ do
508458 paramValue <- option "yes" orgParamValue
509459 return (argKey, paramValue)
510460
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−
522461orgParamValue :: OrgParser String
523462orgParamValue = try $
524463 skipSpaces
@@ -526,19 +465,6 @@ orgParamValue = try $
526465 *> many1 (noneOf "\t\n\r ")
527466 <* skipSpaces
528467
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−
542468commaEscaped :: String -> String
543469commaEscaped (',':cs@('*':_)) = cs
544470commaEscaped (',':cs@('#':'+':_)) = cs
@@ -552,7 +478,10 @@ exampleCode :: String -> Blocks
552478exampleCode = B.codeBlockWith ("", ["example"], [])
553479
554480exampleLine :: 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
556485
557486
558487--
@@ -582,11 +511,6 @@ genericDrawer = try $ do
582511 drawerDiv :: String -> F Blocks -> F Blocks
583512 drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)
584513
585−drawerStart :: OrgParser String
586−drawerStart = try $
587− skipSpaces *> drawerName <* skipSpaces <* newline
588− where drawerName = char ':' *> manyTill nonspaceChar (char ':')
589−
590514drawerLine :: OrgParser String
591515drawerLine = anyLine
592516
@@ -639,31 +563,38 @@ figure = try $ do
639563 let attr = (mempty, mempty, figKeyVals)
640564 return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)
641565 where
566+ withFigPrefix :: String -> String
642567 withFigPrefix cs =
643568 if "fig:" `isPrefixOf` cs
644569 then cs
645570 else "fig:" ++ cs
646571
572+ selfTarget :: OrgParser String
573+ selfTarget = try $ char '[' *> linkTarget <* char ']'
574+
575+
647576--
648577-- Comments, Options and Metadata
649578--
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+
650587specialLine :: OrgParser (F Blocks)
651588specialLine = fmap return . try $ metaLine <|> commentLine
652589
653−metaLine :: OrgParser Blocks
654−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
655−
656590-- The order, in which blocks are tried, makes sure that we're not looking at
657591-- the beginning of a block, so we don't need to check for it
658−metaLineStart :: OrgParser ()
659−metaLineStart = try $ skipSpaces <* string "#+"
592+metaLine :: OrgParser Blocks
593+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
660594
661595commentLine :: OrgParser Blocks
662596commentLine = commentLineStart *> anyLine *> pure mempty
663597
664−commentLineStart :: OrgParser ()
665−commentLineStart = try $ skipSpaces <* string "# "
666−
667598declarationLine :: OrgParser ()
668599declarationLine = try $ do
669600 key <- metaKey
@@ -741,23 +672,6 @@ header = try $ do
741672 *> many1 tag
742673 <* skipSpaces
743674
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
761675
762676--
763677-- Tables
@@ -793,9 +707,6 @@ orgToPandocTable :: OrgTable
793707orgToPandocTable (OrgTable aligns heads lns) caption =
794708 B.table caption (zip aligns $ repeat 0) heads lns
795709
796−tableStart :: OrgParser Char
797−tableStart = try $ skipSpaces *> char '|'
798−
799710tableRows :: OrgParser [OrgTableRow]
800711tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
801712
@@ -899,25 +810,12 @@ latexFragment = try $ do
899810 , "\\end{", e, "}\n"
900811 ]
901812
902−latexEnvStart :: OrgParser String
903−latexEnvStart = try $ do
904− skipSpaces *> string "\\begin{"
905− *> latexEnvName
906− <* string "}"
907− <* blankline
908−
909813latexEnd :: String -> OrgParser ()
910814latexEnd envName = try $
911815 () <$ skipSpaces
912816 <* string ("\\end{" ++ envName ++ "}")
913817 <* blankline
914818
915−-- | Parses a LaTeX environment name.
916−latexEnvName :: OrgParser String
917−latexEnvName = try $ do
918− mappend <$> many1 alphaNum
919− <*> option "" (string "*")
920−
921819
922820--
923821-- Footnote defintions
@@ -942,7 +840,7 @@ paraOrPlain = try $ do
942840 -- is directly followed by a list item, in which case the block is read as
943841 -- plain text.
944842 try (guard nl
945− *> notFollowedBy (inList *> (orderedListStart <|> bulletListStart))
843+ *> notFollowedBy (inList *> (() <$ orderedListStart <|> bulletListStart))
946844 *> return (B.para <$> ils))
947845 <|> (return (B.plain <$> ils))
948846
@@ -971,38 +869,21 @@ orderedList :: OrgParser (F Blocks)
971869orderedList = fmap B.orderedList . fmap compactify' . sequence
972870 <$> many1 (listItem orderedListStart)
973871
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−
984872bulletListStart' :: Maybe Int -> OrgParser Int
985873-- returns length of bulletList prefix, inclusive of marker
986874bulletListStart' Nothing = do ind <- length <$> many spaceChar
987− when (ind == 0) $ notFollowedBy (char '*')
988− oneOf bullets
989− many1 spaceChar
875+ oneOf (bullets $ ind == 0)
876+ skipSpaces1
990877 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
993878bulletListStart' (Just n) = do count (n-1) spaceChar
994− when (n == 1) $ notFollowedBy (char '*')
995− oneOf bullets
879+ oneOf (bullets $ n == 1)
996880 many1 spaceChar
997881 return n
998882
999−bullets :: String
1000−bullets = "*+-"
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 ".)")
883+-- Unindented lists are legal, but they can't use '*' bullets.
884+-- We return n to maintain compatibility with the generic listItem.
885+bullets :: Bool -> String
886+bullets unindented = if unindented then "+-" else "*+-"
1006887
1007888definitionListItem :: OrgParser Int
1008889 -> OrgParser (F (Inlines, [Blocks]))
@@ -1040,602 +921,6 @@ listContinuation markerLength = try $
1040921 <*> many blankline)
1041922 where listLine = try $ indentWith markerLength *> anyLineNewline
1042923
924+-- | Parse any line, include the final newline in the output.
1043925anyLineNewline :: OrgParser String
1044926anyLineNewline = (++ "\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)