@@ -32,11 +32,12 @@ import qualified Text.Pandoc.Builder as B
3232import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..))
3333import Text.Pandoc.Definition
3434import Text.Pandoc.Options
35−import Text.Pandoc.Parsing hiding (orderedListMarker, updateLastStrPos)
35+import qualified Text.Pandoc.Parsing as P
36+import Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos)
3637import Text.Pandoc.Shared (compactify')
3738
3839import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
39−import Control.Monad (guard, mzero)
40+import Control.Monad (guard, when)
4041import Data.Char (toLower)
4142import Data.Default
4243import Data.List (foldl', isPrefixOf, isSuffixOf)
@@ -47,49 +48,100 @@ import Data.Monoid (mconcat, mempty, mappend)
4748readOrg :: ReaderOptions -- ^ Reader options
4849 -> String -- ^ String to parse (assuming @'\n'@ line endings)
4950 -> Pandoc
50−readOrg opts s = (readWith parseOrg) def{ orgOptions = opts } (s ++ "\n\n")
51+readOrg opts s = (readWith parseOrg) def{ orgStateOptions = opts } (s ++ "\n\n")
5152
5253type OrgParser = Parser [Char] OrgParserState
5354
55+parseOrg:: OrgParser Pandoc
56+parseOrg = do
57+ blocks' <- B.toList <$> parseBlocks
58+ st <- getState
59+ let meta = orgStateMeta st
60+ return $ Pandoc meta $ filter (/= Null) blocks'
61+
62+--
63+-- Parser State for Org
64+--
65+
5466-- | Org-mode parser state
5567data OrgParserState = OrgParserState
56− { orgOptions :: ReaderOptions
57− , orgInlineCharStack :: [Char]
58− , orgLastStrPos :: Maybe SourcePos
59− , orgMeta :: Meta
68+ { orgStateOptions :: ReaderOptions
69+ , orgStateEmphasisCharStack :: [Char]
70+ , orgStateEmphasisNewlines :: Maybe Int
71+ , orgStateLastForbiddenCharPos :: Maybe SourcePos
72+ , orgStateLastPreCharPos :: Maybe SourcePos
73+ , orgStateLastStrPos :: Maybe SourcePos
74+ , orgStateMeta :: Meta
6075 } deriving (Show)
6176
6277instance HasReaderOptions OrgParserState where
63− extractReaderOptions = orgOptions
78+ extractReaderOptions = orgStateOptions
6479
6580instance HasMeta OrgParserState where
6681 setMeta field val st =
67− st{ orgMeta = setMeta field val $ orgMeta st }
82+ st{ orgStateMeta = setMeta field val $ orgStateMeta st }
6883 deleteMeta field st =
69− st{ orgMeta = deleteMeta field $ orgMeta st }
84+ st{ orgStateMeta = deleteMeta field $ orgStateMeta st }
7085
7186instance Default OrgParserState where
7287 def = defaultOrgParserState
7388
7489defaultOrgParserState :: OrgParserState
7590defaultOrgParserState = OrgParserState
76− { orgOptions = def
77− , orgInlineCharStack = []
78− , orgLastStrPos = Nothing
79− , orgMeta = nullMeta
91+ { orgStateOptions = def
92+ , orgStateEmphasisCharStack = []
93+ , orgStateEmphasisNewlines = Nothing
94+ , orgStateLastForbiddenCharPos = Nothing
95+ , orgStateLastPreCharPos = Nothing
96+ , orgStateLastStrPos = Nothing
97+ , orgStateMeta = nullMeta
8098 }
8199
82100updateLastStrPos :: OrgParser ()
83101updateLastStrPos = getPosition >>= \p ->
84− updateState $ \s -> s{ orgLastStrPos = Just p }
102+ updateState $ \s -> s{ orgStateLastStrPos = Just p }
85103
104+updateLastForbiddenCharPos :: OrgParser ()
105+updateLastForbiddenCharPos = getPosition >>= \p ->
106+ updateState $ \s -> s{ orgStateLastForbiddenCharPos = Just p}
86107
87−parseOrg:: OrgParser Pandoc
88−parseOrg = do
89− blocks' <- B.toList <$> parseBlocks
108+updateLastPreCharPos :: OrgParser ()
109+updateLastPreCharPos = getPosition >>= \p ->
110+ updateState $ \s -> s{ orgStateLastPreCharPos = Just p}
111+
112+pushToInlineCharStack :: Char -> OrgParser ()
113+pushToInlineCharStack c = updateState $ \st ->
114+ st { orgStateEmphasisCharStack = c:(orgStateEmphasisCharStack st) }
115+
116+popInlineCharStack :: OrgParser ()
117+popInlineCharStack = updateState $ \st ->
118+ st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st }
119+
120+surroundingEmphasisChar :: OrgParser [Char]
121+surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
122+
123+startEmphasisNewlinesCounting :: Int -> OrgParser ()
124+startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
125+ s { orgStateEmphasisNewlines = Just maxNewlines }
126+
127+decEmphasisNewlinesCount :: OrgParser ()
128+decEmphasisNewlinesCount = updateState $ \s ->
129+ s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }
130+
131+newlinesCountWithinLimits :: OrgParser Bool
132+newlinesCountWithinLimits = do
90133 st <- getState
91− let meta = orgMeta st
92− return $ Pandoc meta $ filter (/= Null) blocks'
134+ return $ ((< 0) <$> orgStateEmphasisNewlines st) /= Just True
135+
136+resetEmphasisNewlines :: OrgParser ()
137+resetEmphasisNewlines = updateState $ \s ->
138+ s{ orgStateEmphasisNewlines = Nothing }
139+
140+newline :: OrgParser Char
141+newline =
142+ P.newline
143+ <* updateLastPreCharPos
144+ <* updateLastForbiddenCharPos
93145
94146--
95147-- parsing blocks
@@ -218,7 +270,7 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
218270declarationLine :: OrgParser Blocks
219271declarationLine = try $ do
220272 meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
221− updateState $ \st -> st { orgMeta = orgMeta st <> meta' }
273+ updateState $ \st -> st { orgStateMeta = orgStateMeta st <> meta' }
222274 return mempty
223275
224276metaValue :: OrgParser MetaValue
@@ -449,22 +501,24 @@ anyLineNewline = (++ "\n") <$> anyLine
449501--
450502
451503inline :: OrgParser Inlines
452−inline = choice inlineParsers <?> "inline"
453− where inlineParsers = [ whitespace
454− , link
455− , str
456− , endline
457− , emph
458− , strong
459− , strikeout
460− , underline
461− , code
462− , math
463− , verbatim
464− , subscript
465− , superscript
466− , symbol
467− ]
504+inline =
505+ choice [ whitespace
506+ , link
507+ , str
508+ , endline
509+ , emph
510+ , strong
511+ , strikeout
512+ , underline
513+ , code
514+ , math
515+ , verbatim
516+ , subscript
517+ , superscript
518+ , symbol
519+ ] <* (guard =<< newlinesCountWithinLimits)
520+ <?> "inline"
521+
468522
469523-- treat these as potentially non-text when parsing inline:
470524specialChars :: [Char]
@@ -472,7 +526,10 @@ specialChars = "\"$'()*+-./:<=>[\\]^_{|}~"
472526
473527
474528whitespace :: OrgParser Inlines
475−whitespace = B.space <$ skipMany1 spaceChar <?> "whitespace"
529+whitespace = B.space <$ skipMany1 spaceChar
530+ <* updateLastPreCharPos
531+ <* updateLastForbiddenCharPos
532+ <?> "whitespace"
476533
477534str :: OrgParser Inlines
478535str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
@@ -492,6 +549,9 @@ endline = try $ do
492549 notFollowedBy' commentLineStart
493550 notFollowedBy' bulletListStart
494551 notFollowedBy' orderedListStart
552+ decEmphasisNewlinesCount
553+ guard =<< newlinesCountWithinLimits
554+ updateLastPreCharPos
495555 return B.space
496556
497557link :: OrgParser Inlines
@@ -500,42 +560,54 @@ link = explicitOrImageLink <|> selflinkOrImage <?> "link"
500560explicitOrImageLink :: OrgParser Inlines
501561explicitOrImageLink = try $ do
502562 char '['
503− src <- enclosedRaw (char '[') (char ']')
563+ src <- linkTarget
504564 title <- enclosedRaw (char '[') (char ']')
505565 title' <- parseFromString (mconcat <$> many inline) title
506566 char ']'
507− return $ if (isImage src) && (isImage title)
567+ return $ if (isImageFilename src) && (isImageFilename title)
508568 then B.link src "" (B.image title "" "")
509569 else B.link src "" title'
510570
511571selflinkOrImage :: OrgParser Inlines
512572selflinkOrImage = try $ do
513− src <- enclosedRaw (string "[[") (string "]]")
514− return $ if isImage src
573+ src <- (char '[') *> linkTarget <* char ']'
574+ return $ if isImageFilename src
515575 then B.image src "" ""
516576 else B.link src "" (B.str src)
517577
578+linkTarget :: OrgParser String
579+linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
580+
581+isImageFilename :: String -> Bool
582+isImageFilename filename =
583+ any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
584+ any (\x -> (x++":") `isPrefixOf` filename) protocols ||
585+ ':' `notElem` filename
586+ where
587+ imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
588+ protocols = [ "file", "http", "https" ]
589+
518590emph :: OrgParser Inlines
519−emph = B.emph <$> inlinesEnclosedBy '/'
591+emph = B.emph <$> emphasisBetween '/'
520592
521593strong :: OrgParser Inlines
522−strong = B.strong <$> inlinesEnclosedBy '*'
594+strong = B.strong <$> emphasisBetween '*'
523595
524596strikeout :: OrgParser Inlines
525−strikeout = B.strikeout <$> inlinesEnclosedBy '+'
597+strikeout = B.strikeout <$> emphasisBetween '+'
526598
527599-- There is no underline, so we use strong instead.
528600underline :: OrgParser Inlines
529−underline = B.strong <$> inlinesEnclosedBy '_'
601+underline = B.strong <$> emphasisBetween '_'
530602
531603code :: OrgParser Inlines
532−code = B.code <$> rawEnclosedBy '='
533−
534−math :: OrgParser Inlines
535−math = B.math <$> rawEnclosedBy '$'
604+code = B.code <$> verbatimBetween '='
536605
537606verbatim :: OrgParser Inlines
538−verbatim = B.rawInline "" <$> rawEnclosedBy '~'
607+verbatim = B.rawInline "" <$> verbatimBetween '~'
608+
609+math :: OrgParser Inlines
610+math = B.math <$> mathStringBetween '$'
539611
540612subscript :: OrgParser Inlines
541613subscript = B.subscript <$> (try $ char '_' *> maybeGroupedByBraces)
@@ -550,7 +622,72 @@ maybeGroupedByBraces = try $
550622 ]
551623
552624symbol :: OrgParser Inlines
553−symbol = B.str . (: "") <$> oneOf specialChars
625+symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
626+ where updatePositions c
627+ | c `elem` emphasisPreChars = c <$ updateLastPreCharPos
628+ | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos
629+ | otherwise = return c
630+
631+emphasisBetween :: Char
632+ -> OrgParser Inlines
633+emphasisBetween c = try $ do
634+ startEmphasisNewlinesCounting emphasisAllowedNewlines
635+ res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
636+ isTopLevelEmphasis <- null . orgStateEmphasisCharStack <$> getState
637+ when isTopLevelEmphasis
638+ resetEmphasisNewlines
639+ return res
640+
641+verbatimBetween :: Char
642+ -> OrgParser String
643+verbatimBetween c = try $
644+ emphasisStart c *>
645+ many1TillNOrLessNewlines 1 (noneOf "\n\r") (emphasisEnd c)
646+
647+-- | Parses a raw string delimited by @c@ using Org's math rules
648+mathStringBetween :: Char
649+ -> OrgParser String
650+mathStringBetween c = try $ do
651+ mathStart c
652+ body <- many1TillNOrLessNewlines mathAllowedNewlines
653+ (noneOf (c:"\n\r"))
654+ (lookAhead $ mathEnd c)
655+ final <- mathEnd c
656+ return $ body ++ [final]
657+
658+-- | Parses the start (opening character) of emphasis
659+emphasisStart :: Char -> OrgParser Char
660+emphasisStart c = try $ do
661+ guard =<< afterEmphasisPreChar
662+ guard =<< notAfterString
663+ char c
664+ lookAhead (noneOf emphasisForbiddenBorderChars)
665+ pushToInlineCharStack c
666+ return c
667+
668+-- | Parses the closing character of emphasis
669+emphasisEnd :: Char -> OrgParser Char
670+emphasisEnd c = try $ do
671+ guard =<< notAfterForbiddenBorderChar
672+ char c
673+ eof <|> lookAhead (surroundingEmphasisChar >>= \x ->
674+ oneOf (x ++ emphasisPostChars))
675+ *> return ()
676+ updateLastStrPos
677+ popInlineCharStack
678+ return c
679+
680+mathStart :: Char -> OrgParser Char
681+mathStart c = try $ do
682+ char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))
683+
684+mathEnd :: Char -> OrgParser Char
685+mathEnd c = try $ do
686+ res <- noneOf (c:mathForbiddenBorderChars)
687+ char c
688+ eof <|> (lookAhead $ oneOf mathPostChars *> pure ())
689+ return res
690+
554691
555692enclosedInlines :: OrgParser a
556693 -> OrgParser b
@@ -558,16 +695,6 @@ enclosedInlines :: OrgParser a
558695enclosedInlines start end = try $
559696 trimInlines . mconcat <$> enclosed start end inline
560697
561−-- FIXME: This is a hack
562−inlinesEnclosedBy :: Char
563− -> OrgParser Inlines
564−inlinesEnclosedBy c = try $ do
565− updateState $ \st -> st { orgInlineCharStack = c:(orgInlineCharStack st) }
566− res <- enclosedInlines (atStart (char c) <* endsOnThisOrNextLine c)
567− (atEnd $ char c)
568− updateState $ \st -> st { orgInlineCharStack = drop 1 . orgInlineCharStack $ st }
569− return res
570−
571698enclosedRaw :: OrgParser a
572699 -> OrgParser b
573700 -> OrgParser String
@@ -577,63 +704,76 @@ enclosedRaw start end = try $
577704 spanningTwoLines = try $
578705 anyLine >>= \f -> mappend (f <> " ") <$> onSingleLine
579706
580−rawEnclosedBy :: Char
581− -> OrgParser String
582−rawEnclosedBy c = enclosedRaw (atStart $ char c) (atEnd $ char c)
583−
584−-- succeeds only if we're not right after a str (ie. in middle of word)
585−atStart :: OrgParser a -> OrgParser a
586−atStart p = do
587− guard =<< not <$> isRightAfterString
588− p
589−
590−-- | succeeds only if we're at the end of a word
591−atEnd :: OrgParser a -> OrgParser a
592−atEnd p = try $ do
593− p <* lookingAtEndOfWord
594− where lookingAtEndOfWord =
595− eof <|> const (return ()) =<< lookAhead . oneOf =<< postWordChars
596−
597−isRightAfterString :: OrgParser Bool
598−isRightAfterString = do
707+-- | Like many1Till, but parses at most @n+1@ lines. @p@ must not consume
708+-- newlines.
709+many1TillNOrLessNewlines :: Int
710+ -> OrgParser Char
711+ -> OrgParser a
712+ -> OrgParser String
713+many1TillNOrLessNewlines n p end = try $
714+ nMoreLines (Just n) mempty >>= oneOrMore
715+ where
716+ nMoreLines Nothing cs = return cs
717+ nMoreLines (Just 0) cs = try $ (cs ++) <$> finalLine
718+ nMoreLines k cs = try $ (final k cs <|> rest k cs)
719+ >>= uncurry nMoreLines
720+ final _ cs = (\x -> (Nothing, cs ++ x)) <$> (try finalLine)
721+ rest m cs = (\x -> (minus1 <$> m, cs ++ x ++ "\n")) <$> (try $ manyTill p P.newline)
722+ finalLine = try $ manyTill p end
723+ minus1 k = k - 1
724+ oneOrMore cs = guard (not $ null cs) *> return cs
725+
726+-- Org allows customization of the way it reads emphasis. We use the defaults
727+-- here (see, e.g., the Emacs Lisp variable `org-emphasis-regexp-components`
728+-- for details).
729+
730+-- | Chars allowed to occur before emphasis (spaces and newlines are ok, too)
731+emphasisPreChars :: [Char]
732+emphasisPreChars = "\t \"'({"
733+
734+-- | Chars allowed at after emphasis
735+emphasisPostChars :: [Char]
736+emphasisPostChars = "\t\n !\"'),-.:;?\\}"
737+
738+-- | Chars not allowed at the (inner) border of emphasis
739+emphasisForbiddenBorderChars :: [Char]
740+emphasisForbiddenBorderChars = "\t\n\r \"',"
741+
742+-- | The maximum number of newlines within
743+emphasisAllowedNewlines :: Int
744+emphasisAllowedNewlines = 1
745+
746+-- LaTeX-style math: see `org-latex-regexps` for details
747+
748+-- | Chars allowed after an inline ($...$) math statement
749+mathPostChars :: [Char]
750+mathPostChars = "\t\n \"',-.:;?"
751+
752+-- | Chars not allowed at the (inner) border of math
753+mathForbiddenBorderChars :: [Char]
754+mathForbiddenBorderChars = "\t\n\r ,;.$"
755+
756+-- | Maximum number of newlines in an inline math statement
757+mathAllowedNewlines :: Int
758+mathAllowedNewlines = 2
759+
760+-- | Whether we are right behind a char allowed before emphasis
761+afterEmphasisPreChar :: OrgParser Bool
762+afterEmphasisPreChar = do
599763 pos <- getPosition
600− st <- getState
601− -- the position `Nothing` isn't after a String, either, hence the double
602− -- negation
603− return $ not $ orgLastStrPos st /= Just pos
764+ lastPrePos <- orgStateLastPreCharPos <$> getState
765+ return $ lastPrePos == Nothing || lastPrePos == Just pos
604766
605−postWordChars :: OrgParser [Char]
606−postWordChars = do
607− st <- getState
608− return $ "\t\n\r !\"'),-.:?}" ++ (take 1 . drop 1 . orgInlineCharStack $ st)
609−
610−-- FIXME: These functions are hacks and should be replaced
611−endsOnThisOrNextLine :: Char
612− -> OrgParser ()
613−endsOnThisOrNextLine c = do
614− inp <- getInput
615− let doOtherwise = \rest -> endsOnThisLine rest c (const mzero)
616− endsOnThisLine inp c doOtherwise
617−
618−endsOnThisLine :: [Char]
619− -> Char
620− -> ([Char] -> OrgParser ())
621− -> OrgParser ()
622−endsOnThisLine input c doOnOtherLines = do
623− postWordChars' <- postWordChars
624− case break (`elem` c:"\n") input of
625− (_,'\n':rest) -> doOnOtherLines rest
626− (_,_:[]) -> return ()
627− (_,_:rest@(n:_)) -> if n `elem` postWordChars'
628− then return ()
629− else endsOnThisLine rest c doOnOtherLines
630− _ -> mzero
631−
632−isImage :: String -> Bool
633−isImage filename =
634− any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
635− any (\x -> (x++":") `isPrefixOf` filename) protocols ||
636− ':' `notElem` filename
637− where
638− imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
639− protocols = [ "file", "http", "https" ]
767+-- | Whether we are right after the end of a string
768+notAfterString :: OrgParser Bool
769+notAfterString = do
770+ pos <- getPosition
771+ lastStrPos <- orgStateLastStrPos <$> getState
772+ return $ lastStrPos /= Just pos
773+
774+-- | Whether the parser is right after a forbidden border char
775+notAfterForbiddenBorderChar :: OrgParser Bool
776+notAfterForbiddenBorderChar = do
777+ pos <- getPosition
778+ lastFBCPos <- orgStateLastForbiddenCharPos <$> getState
779+ return $ lastFBCPos /= Just pos