@@ -1,4 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
23{-
34Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
45
@@ -24,26 +25,32 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2425
2526 Maintainer : Albert Krewinkel <tarleb@moltkeplatz.de>
2627
27−Conversion of Org-Mode to 'Pandoc' document.
28+Conversion of org-mode formatted plain text to 'Pandoc' document.
2829-}
2930module Text.Pandoc.Readers.Org ( readOrg ) where
3031
3132import qualified Text.Pandoc.Builder as B
32−import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..))
33+import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>)
34+ , trimInlines )
3335import Text.Pandoc.Definition
3436import Text.Pandoc.Options
3537import qualified Text.Pandoc.Parsing as P
36−import Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos)
37−import Text.Pandoc.Shared (compactify')
38−
39−import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
40−import Control.Arrow ((***))
41−import Control.Monad (guard, when)
38+import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF
39+ , newline, orderedListMarker
40+ , parseFromString
41+ , updateLastStrPos )
42+import Text.Pandoc.Shared (compactify', compactify'DL)
43+
44+import Control.Applicative ( Applicative, pure
45+ , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
46+import Control.Monad (foldM, guard, liftM, liftM2, when)
47+import Control.Monad.Reader (Reader, runReader, ask, asks)
4248import Data.Char (toLower)
4349import Data.Default
44−import Data.List (foldl', isPrefixOf, isSuffixOf)
45−import Data.Maybe (listToMaybe, fromMaybe)
46−import Data.Monoid (mconcat, mempty, mappend)
50+import Data.List (intersperse, isPrefixOf, isSuffixOf)
51+import qualified Data.Map as M
52+import Data.Maybe (listToMaybe, fromMaybe, isJust)
53+import Data.Monoid (Monoid, mconcat, mempty, mappend)
4754
4855-- | Parse org-mode string and return a Pandoc document.
4956readOrg :: ReaderOptions -- ^ Reader options
@@ -53,27 +60,35 @@ readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
5360
5461type OrgParser = Parser [Char] OrgParserState
5562
56−parseOrg:: OrgParser Pandoc
63+parseOrg :: OrgParser Pandoc
5764parseOrg = do
58− blocks' <- B.toList <$> parseBlocks
65+ blocks' <- parseBlocks
5966 st <- getState
60− let meta = orgStateMeta st
61− return $ Pandoc meta $ filter (/= Null) blocks'
67+ let meta = runF (orgStateMeta' st) st
68+ return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st)
6269
6370--
6471-- Parser State for Org
6572--
6673
74+type OrgNoteRecord = (String, F Blocks)
75+type OrgNoteTable = [OrgNoteRecord]
76+
77+type OrgBlockAttributes = M.Map String String
78+
6779-- | Org-mode parser state
6880data OrgParserState = OrgParserState
6981 { orgStateOptions :: ReaderOptions
82+ , orgStateBlockAttributes :: OrgBlockAttributes
7083 , orgStateEmphasisCharStack :: [Char]
7184 , orgStateEmphasisNewlines :: Maybe Int
7285 , orgStateLastForbiddenCharPos :: Maybe SourcePos
7386 , orgStateLastPreCharPos :: Maybe SourcePos
7487 , orgStateLastStrPos :: Maybe SourcePos
7588 , orgStateMeta :: Meta
76− } deriving (Show)
89+ , orgStateMeta' :: F Meta
90+ , orgStateNotes' :: OrgNoteTable
91+ }
7792
7893instance HasReaderOptions OrgParserState where
7994 extractReaderOptions = orgStateOptions
@@ -90,14 +105,30 @@ instance Default OrgParserState where
90105defaultOrgParserState :: OrgParserState
91106defaultOrgParserState = OrgParserState
92107 { orgStateOptions = def
108+ , orgStateBlockAttributes = M.empty
93109 , orgStateEmphasisCharStack = []
94110 , orgStateEmphasisNewlines = Nothing
95111 , orgStateLastForbiddenCharPos = Nothing
96112 , orgStateLastPreCharPos = Nothing
97113 , orgStateLastStrPos = Nothing
98114 , orgStateMeta = nullMeta
115+ , orgStateMeta' = return nullMeta
116+ , orgStateNotes' = []
99117 }
100118
119+addBlockAttribute :: String -> String -> OrgParser ()
120+addBlockAttribute key val = updateState $ \s ->
121+ let attrs = orgStateBlockAttributes s
122+ in s{ orgStateBlockAttributes = M.insert key val attrs }
123+
124+lookupBlockAttribute :: String -> OrgParser (Maybe String)
125+lookupBlockAttribute key =
126+ M.lookup key . orgStateBlockAttributes <$> getState
127+
128+resetBlockAttributes :: OrgParser ()
129+resetBlockAttributes = updateState $ \s ->
130+ s{ orgStateBlockAttributes = orgStateBlockAttributes def }
131+
101132updateLastStrPos :: OrgParser ()
102133updateLastStrPos = getPosition >>= \p ->
103134 updateState $ \s -> s{ orgStateLastStrPos = Just p }
@@ -111,19 +142,19 @@ updateLastPreCharPos = getPosition >>= \p ->
111142 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}
112143
113144pushToInlineCharStack :: Char -> OrgParser ()
114−pushToInlineCharStack c = updateState $ \st ->
115− st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st }
145+pushToInlineCharStack c = updateState $ \s ->
146+ s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }
116147
117148popInlineCharStack :: OrgParser ()
118−popInlineCharStack = updateState $ \st ->
119− st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st }
149+popInlineCharStack = updateState $ \s ->
150+ s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }
120151
121152surroundingEmphasisChar :: OrgParser [Char]
122153surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
123154
124155startEmphasisNewlinesCounting :: Int -> OrgParser ()
125156startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
126− s { orgStateEmphasisNewlines = Just maxNewlines }
157+ s{ orgStateEmphasisNewlines = Just maxNewlines }
127158
128159decEmphasisNewlinesCount :: OrgParser ()
129160decEmphasisNewlinesCount = updateState $ \s ->
@@ -138,6 +169,48 @@ resetEmphasisNewlines :: OrgParser ()
138169resetEmphasisNewlines = updateState $ \s ->
139170 s{ orgStateEmphasisNewlines = Nothing }
140171
172+addToNotesTable :: OrgNoteRecord -> OrgParser ()
173+addToNotesTable note = do
174+ oldnotes <- orgStateNotes' <$> getState
175+ updateState $ \s -> s{ orgStateNotes' = note:oldnotes }
176+
177+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts
178+-- of the state saved and restored.
179+parseFromString :: OrgParser a -> String -> OrgParser a
180+parseFromString parser str' = do
181+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState
182+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }
183+ result <- P.parseFromString parser str'
184+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }
185+ return result
186+
187+
188+--
189+-- Adaptions and specializations of parsing utilities
190+--
191+
192+newtype F a = F { unF :: Reader OrgParserState a
193+ } deriving (Monad, Applicative, Functor)
194+
195+runF :: F a -> OrgParserState -> a
196+runF = runReader . unF
197+
198+askF :: F OrgParserState
199+askF = F ask
200+
201+asksF :: (OrgParserState -> a) -> F a
202+asksF f = F $ asks f
203+
204+instance Monoid a => Monoid (F a) where
205+ mempty = return mempty
206+ mappend = liftM2 mappend
207+ mconcat = fmap mconcat . sequence
208+
209+trimInlinesF :: F Inlines -> F Inlines
210+trimInlinesF = liftM trimInlines
211+
212+
213+-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
141214newline :: OrgParser Char
142215newline =
143216 P.newline
@@ -148,37 +221,83 @@ newline =
148221-- parsing blocks
149222--
150223
151−parseBlocks :: OrgParser Blocks
224+parseBlocks :: OrgParser (F Blocks)
152225parseBlocks = mconcat <$> manyTill block eof
153226
154−block :: OrgParser Blocks
227+block :: OrgParser (F Blocks)
155228block = choice [ mempty <$ blanklines
156− , orgBlock
229+ , optionalAttributes $ choice
230+ [ orgBlock
231+ , figure
232+ , table
233+ ]
157234 , example
158235 , drawer
159− , figure
160236 , specialLine
161237 , header
162− , hline
238+ , return <$> hline
163239 , list
164− , table
240+ , latexFragment
241+ , noteBlock
165242 , paraOrPlain
166243 ] <?> "block"
167244
245+optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
246+optionalAttributes parser = try $
247+ resetBlockAttributes *> parseBlockAttributes *> parser
248+
249+parseBlockAttributes :: OrgParser ()
250+parseBlockAttributes = do
251+ attrs <- many attribute
252+ () <$ mapM (uncurry parseAndAddAttribute) attrs
253+ where
254+ attribute :: OrgParser (String, String)
255+ attribute = try $ do
256+ key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':')
257+ val <- skipSpaces *> anyLine
258+ return (map toLower key, val)
259+
260+parseAndAddAttribute :: String -> String -> OrgParser ()
261+parseAndAddAttribute key value = do
262+ let key' = map toLower key
263+ () <$ addBlockAttribute key' value
264+
265+lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
266+lookupInlinesAttr attr = try $ do
267+ val <- lookupBlockAttribute attr
268+ maybe (return Nothing)
269+ (fmap Just . parseFromString parseInlines)
270+ val
271+
272+
168273--
169274-- Org Blocks (#+BEGIN_... / #+END_...)
170275--
171276
172−orgBlock :: OrgParser Blocks
277+orgBlock :: OrgParser (F Blocks)
173278orgBlock = try $ do
174279 (indent, blockType, args) <- blockHeader
175− blockStr <- rawBlockContent indent blockType
280+ content <- rawBlockContent indent blockType
281+ contentBlocks <- parseFromString parseBlocks (content ++ "\n")
176282 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
177283 case blockType of
178284 "comment" -> return mempty
179− "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr
180− _ -> B.divWith ("", [blockType], [])
181− <$> parseFromString parseBlocks blockStr
285+ "html" -> returnF $ B.rawBlock "html" content
286+ "latex" -> returnF $ B.rawBlock "latex" content
287+ "ascii" -> returnF $ B.rawBlock "ascii" content
288+ "example" -> returnF $ exampleCode content
289+ "quote" -> return $ B.blockQuote <$> contentBlocks
290+ "verse" -> parseVerse content
291+ "src" -> codeBlockWithAttr classArgs content
292+ _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
293+ where
294+ returnF :: a -> OrgParser (F a)
295+ returnF = return . return
296+
297+ parseVerse :: String -> OrgParser (F Blocks)
298+ parseVerse cs =
299+ fmap B.para . mconcat . intersperse (pure B.linebreak)
300+ <$> mapM (parseFromString parseInlines) (lines cs)
182301
183302blockHeader :: OrgParser (Int, String, [String])
184303blockHeader = (,,) <$> blockIndent
@@ -188,6 +307,18 @@ blockHeader = (,,) <$> blockIndent
188307 blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)
189308 blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline
190309
310+codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks)
311+codeBlockWithAttr classArgs content = do
312+ identifier <- fromMaybe "" <$> lookupBlockAttribute "name"
313+ caption <- lookupInlinesAttr "caption"
314+ let codeBlck = B.codeBlockWith (identifier, classArgs, []) content
315+ return $ maybe (pure codeBlck) (labelDiv codeBlck) caption
316+ where
317+ labelDiv blk value =
318+ B.divWith nullAttr <$> (mappend <$> labelledBlock value
319+ <*> pure blk)
320+ labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
321+
191322rawBlockContent :: Int -> String -> OrgParser String
192323rawBlockContent indent blockType =
193324 unlines . map commaEscaped <$> manyTill indentedLine blockEnder
@@ -222,15 +353,18 @@ commaEscaped (',':cs@('*':_)) = cs
222353commaEscaped (',':cs@('#':'+':_)) = cs
223354commaEscaped cs = cs
224355
225−example :: OrgParser Blocks
226−example = try $
227− B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine
356+example :: OrgParser (F Blocks)
357+example = try $ do
358+ return . return . exampleCode =<< unlines <$> many1 exampleLine
359+
360+exampleCode :: String -> Blocks
361+exampleCode = B.codeBlockWith ("", ["example"], [])
228362
229363exampleLine :: OrgParser String
230364exampleLine = try $ string ": " *> anyLine
231365
232366-- Drawers for properties or a logbook
233−drawer :: OrgParser Blocks
367+drawer :: OrgParser (F Blocks)
234368drawer = try $ do
235369 drawerStart
236370 manyTill drawerLine (try drawerEnd)
@@ -256,41 +390,31 @@ drawerEnd = try $
256390--
257391
258392-- Figures (Image on a line by itself, preceded by name and/or caption)
259−figure :: OrgParser Blocks
393+figure :: OrgParser (F Blocks)
260394figure = try $ do
261− (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)
262− <$> nameAndOrCaption
395+ (cap, nam) <- nameAndCaption
263396 src <- skipSpaces *> selfTarget <* skipSpaces <* newline
264397 guard (isImageFilename src)
265− return . B.para $ B.image src tit cap
266− where withFigPrefix cs = if "fig:" `isPrefixOf` cs
267− then cs
268− else "fig:" ++ cs
269−
270−nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines)
271−nameAndOrCaption = try $ nameFirst <|> captionFirst
398+ return $ do
399+ cap' <- cap
400+ return $ B.para $ B.image src nam cap'
272401 where
273− nameFirst = try $ do
274− n <- name
275− c <- optionMaybe caption
276− return (Just n, c)
277− captionFirst = try $ do
278− c <- caption
279− n <- optionMaybe name
280− return (n, Just c)
281−
282−caption :: OrgParser Inlines
283−caption = try $ annotation "CAPTION" *> inlinesTillNewline
284−
285−name :: OrgParser String
286−name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline
287−
288−annotation :: String -> OrgParser String
289−annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'
402+ nameAndCaption =
403+ do
404+ maybeCap <- lookupInlinesAttr "caption"
405+ maybeNam <- lookupBlockAttribute "name"
406+ guard $ isJust maybeCap || isJust maybeNam
407+ return ( fromMaybe mempty maybeCap
408+ , maybe mempty withFigPrefix maybeNam )
409+ withFigPrefix cs =
410+ if "fig:" `isPrefixOf` cs
411+ then cs
412+ else "fig:" ++ cs
290413
414+--
291415-- Comments, Options and Metadata
292−specialLine :: OrgParser Blocks
293−specialLine = try $ metaLine <|> commentLine
416+specialLine :: OrgParser (F Blocks)
417+specialLine = fmap return . try $ metaLine <|> commentLine
294418
295419metaLine :: OrgParser Blocks
296420metaLine = try $ metaLineStart *> declarationLine
@@ -308,29 +432,41 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
308432
309433declarationLine :: OrgParser Blocks
310434declarationLine = try $ do
311− meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
312− updateState $ \st -> st { orgStateMeta = orgStateMeta st <> meta' }
435+ key <- metaKey
436+ inlinesF <- metaInlines
437+ updateState $ \st ->
438+ let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
439+ in st { orgStateMeta' = orgStateMeta' st <> meta' }
313440 return mempty
314441
315−metaValue :: OrgParser MetaValue
316−metaValue = MetaInlines . B.toList <$> inlinesTillNewline
442+metaInlines :: OrgParser (F MetaValue)
443+metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
317444
318445metaKey :: OrgParser String
319446metaKey = map toLower <$> many1 (noneOf ": \n\r")
320447 <* char ':'
321448 <* skipSpaces
322449
450+--
451+-- Headers
452+--
453+
323454-- | Headers
324−header :: OrgParser Blocks
325−header = try $
326− B.header <$> headerStart
327− <*> inlinesTillNewline
455+header :: OrgParser (F Blocks)
456+header = try $ do
457+ level <- headerStart
458+ title <- inlinesTillNewline
459+ return $ B.header level <$> title
328460
329461headerStart :: OrgParser Int
330462headerStart = try $
331463 (length <$> many1 (char '*')) <* many1 (char ' ')
332464
333−-- Horizontal Line (five dashes or more)
465+
466+-- Don't use (or need) the reader wrapper here, we want hline to be
467+-- @show@able. Otherwise we can't use it with @notFollowedBy'@.
468+
469+-- | Horizontal Line (five -- dashes or more)
334470hline :: OrgParser Blocks
335471hline = try $ do
336472 skipSpaces
@@ -344,27 +480,30 @@ hline = try $ do
344480-- Tables
345481--
346482
347−data OrgTableRow = OrgContentRow [Blocks]
483+data OrgTableRow = OrgContentRow (F [Blocks])
348484 | OrgAlignRow [Alignment]
349485 | OrgHlineRow
350− deriving (Eq, Show)
351486
352487data OrgTable = OrgTable
353488 { orgTableColumns :: Int
354489 , orgTableAlignments :: [Alignment]
355490 , orgTableHeader :: [Blocks]
356491 , orgTableRows :: [[Blocks]]
357− } deriving (Eq, Show)
492+ }
358493
359−table :: OrgParser Blocks
494+table :: OrgParser (F Blocks)
360495table = try $ do
361496 lookAhead tableStart
362− orgToPandocTable . normalizeTable . rowsToTable <$> tableRows
497+ do
498+ rows <- tableRows
499+ cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
500+ return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
363501
364502orgToPandocTable :: OrgTable
503+ -> Inlines
365504 -> Blocks
366−orgToPandocTable (OrgTable _ aligns heads lns) =
367− B.table "" (zip aligns $ repeat 0) heads lns
505+orgToPandocTable (OrgTable _ aligns heads lns) caption =
506+ B.table caption (zip aligns $ repeat 0) heads lns
368507
369508tableStart :: OrgParser Char
370509tableStart = try $ skipSpaces *> char '|'
@@ -374,11 +513,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
374513
375514tableContentRow :: OrgParser OrgTableRow
376515tableContentRow = try $
377− OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
516+ OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)
378517
379−tableContentCell :: OrgParser Blocks
518+tableContentCell :: OrgParser (F Blocks)
380519tableContentCell = try $
381− B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
520+ fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell
382521
383522endOfCell :: OrgParser Char
384523endOfCell = try $ char '|' <|> lookAhead newline
@@ -410,8 +549,8 @@ tableHline = try $
410549 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
411550
412551rowsToTable :: [OrgTableRow]
413− -> OrgTable
414−rowsToTable = foldl' (flip rowToContent) zeroTable
552+ -> F OrgTable
553+rowsToTable = foldM (flip rowToContent) zeroTable
415554 where zeroTable = OrgTable 0 mempty mempty mempty
416555
417556normalizeTable :: OrgTable
@@ -430,57 +569,113 @@ normalizeTable (OrgTable cols aligns heads lns) =
430569-- line as a header. All other horizontal lines are discarded.
431570rowToContent :: OrgTableRow
432571 -> OrgTable
433− -> OrgTable
434−rowToContent OrgHlineRow = maybeBodyToHeader
435−rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs
436−rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as
572+ -> F OrgTable
573+rowToContent OrgHlineRow t = maybeBodyToHeader t
574+rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t
575+rowToContent (OrgContentRow rf) t = do
576+ rs <- rf
577+ setLongestRow rs =<< appendToBody rs t
437578
438579setLongestRow :: [a]
439580 -> OrgTable
440− -> OrgTable
441−setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) }
581+ -> F OrgTable
582+setLongestRow rs t =
583+ return t{ orgTableColumns = max (length rs) (orgTableColumns t) }
442584
443585maybeBodyToHeader :: OrgTable
444− -> OrgTable
586+ -> F OrgTable
445587maybeBodyToHeader t = case t of
446588 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
447− t{ orgTableHeader = b , orgTableRows = [] }
448− _ -> t
589+ return t{ orgTableHeader = b , orgTableRows = [] }
590+ _ -> return t
449591
450592appendToBody :: [Blocks]
451593 -> OrgTable
452− -> OrgTable
453−appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
594+ -> F OrgTable
595+appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }
454596
455597setAligns :: [Alignment]
456598 -> OrgTable
457− -> OrgTable
458−setAligns aligns t = t{ orgTableAlignments = aligns }
599+ -> F OrgTable
600+setAligns aligns t = return $ t{ orgTableAlignments = aligns }
601+
602+
603+--
604+-- LaTeX fragments
605+--
606+latexFragment :: OrgParser (F Blocks)
607+latexFragment = try $ do
608+ envName <- latexEnvStart
609+ content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)
610+ return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)
611+ where
612+ c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"
613+ , c
614+ , "\\end{", e, "}\n"
615+ ]
616+
617+latexEnvStart :: OrgParser String
618+latexEnvStart = try $ do
619+ skipSpaces *> string "\\begin{"
620+ *> latexEnvName
621+ <* string "}"
622+ <* blankline
623+
624+latexEnd :: String -> OrgParser ()
625+latexEnd envName = try $
626+ () <$ skipSpaces
627+ <* string ("\\end{" ++ envName ++ "}")
628+ <* blankline
629+
630+-- | Parses a LaTeX environment name.
631+latexEnvName :: OrgParser String
632+latexEnvName = try $ do
633+ mappend <$> many1 alphaNum
634+ <*> option "" (string "*")
635+
636+
637+--
638+-- Footnote defintions
639+--
640+noteBlock :: OrgParser (F Blocks)
641+noteBlock = try $ do
642+ ref <- noteMarker <* skipSpaces
643+ content <- mconcat <$> blocksTillHeaderOrNote
644+ addToNotesTable (ref, content)
645+ return mempty
646+ where
647+ blocksTillHeaderOrNote =
648+ many1Till block (eof <|> () <$ lookAhead noteMarker
649+ <|> () <$ lookAhead headerStart)
459650
460651-- Paragraphs or Plain text
461−paraOrPlain :: OrgParser Blocks
652+paraOrPlain :: OrgParser (F Blocks)
462653paraOrPlain = try $
463− parseInlines <**> option B.plain (try $ newline *> pure B.para)
654+ parseInlines <**> (fmap <$> option B.plain (try $ newline *> pure B.para))
464655
465−inlinesTillNewline :: OrgParser Inlines
466−inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
656+inlinesTillNewline :: OrgParser (F Inlines)
657+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
467658
468659
469660--
470661-- list blocks
471662--
472663
473−list :: OrgParser Blocks
664+list :: OrgParser (F Blocks)
474665list = choice [ definitionList, bulletList, orderedList ] <?> "list"
475666
476−definitionList :: OrgParser Blocks
477−definitionList = B.definitionList <$> many1 (definitionListItem bulletListStart)
667+definitionList :: OrgParser (F Blocks)
668+definitionList = fmap B.definitionList . fmap compactify'DL . sequence
669+ <$> many1 (definitionListItem bulletListStart)
478670
479−bulletList :: OrgParser Blocks
480−bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)
671+bulletList :: OrgParser (F Blocks)
672+bulletList = fmap B.bulletList . fmap compactify' . sequence
673+ <$> many1 (listItem bulletListStart)
481674
482−orderedList :: OrgParser Blocks
483−orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
675+orderedList :: OrgParser (F Blocks)
676+-- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
677+orderedList = fmap B.orderedList . fmap compactify' . sequence
678+ <$> many1 (listItem orderedListStart)
484679
485680genericListStart :: OrgParser String
486681 -> OrgParser Int
@@ -499,33 +694,36 @@ orderedListStart = genericListStart orderedListMarker
499694 where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
500695
501696definitionListItem :: OrgParser Int
502− -> OrgParser (Inlines, [Blocks])
697+ -> OrgParser (F (Inlines, [Blocks]))
503698definitionListItem parseMarkerGetLength = try $ do
504699 markerLength <- parseMarkerGetLength
505700 term <- manyTill (noneOf "\n\r") (try $ string "::")
506701 first <- anyLineNewline
702+ blank <- option "" ("\n" <$ blankline)
507703 cont <- concat <$> many (listContinuation markerLength)
508704 term' <- parseFromString inline term
509− contents' <- parseFromString parseBlocks $ first ++ cont
510− return (term', [contents'])
705+ contents' <- parseFromString parseBlocks $ first ++ blank ++ cont
706+ return $ (,) <$> term' <*> fmap (:[]) contents'
511707
512708
513709-- parse raw text for one list item, excluding start marker and continuations
514710listItem :: OrgParser Int
515− -> OrgParser Blocks
711+ -> OrgParser (F Blocks)
516712listItem start = try $ do
517713 markerLength <- try start
518714 firstLine <- anyLineNewline
715+ blank <- option "" ("\n" <$ blankline)
519716 rest <- concat <$> many (listContinuation markerLength)
520− parseFromString parseBlocks $ firstLine ++ rest
717+ parseFromString parseBlocks $ firstLine ++ blank ++ rest
521718
522719-- continuation of a list item - indented and separated by blankline or endline.
523720-- Note: nested lists are parsed as continuations.
524721listContinuation :: Int
525722 -> OrgParser String
526723listContinuation markerLength = try $
527− mappend <$> many blankline
528− <*> (concat <$> many1 listLine)
724+ notFollowedBy' blankline
725+ *> (mappend <$> (concat <$> many1 listLine)
726+ <*> many blankline)
529727 where listLine = try $ indentWith markerLength *> anyLineNewline
530728
531729anyLineNewline :: OrgParser String
@@ -536,11 +734,12 @@ anyLineNewline = (++ "\n") <$> anyLine
536734-- inline
537735--
538736
539−inline :: OrgParser Inlines
737+inline :: OrgParser (F Inlines)
540738inline =
541739 choice [ whitespace
542740 , linebreak
543− , link
741+ , footnote
742+ , linkOrImage
544743 , str
545744 , endline
546745 , emph
@@ -557,67 +756,104 @@ inline =
557756 ] <* (guard =<< newlinesCountWithinLimits)
558757 <?> "inline"
559758
560−parseInlines :: OrgParser Inlines
561−parseInlines = trimInlines . mconcat <$> many1 inline
759+parseInlines :: OrgParser (F Inlines)
760+parseInlines = trimInlinesF . mconcat <$> many1 inline
562761
563762-- treat these as potentially non-text when parsing inline:
564763specialChars :: [Char]
565764specialChars = "\"$'()*+-./:<=>[\\]^_{|}~"
566765
567766
568−whitespace :: OrgParser Inlines
569−whitespace = B.space <$ skipMany1 spaceChar
570− <* updateLastPreCharPos
571− <* updateLastForbiddenCharPos
767+whitespace :: OrgParser (F Inlines)
768+whitespace = pure B.space <$ skipMany1 spaceChar
769+ <* updateLastPreCharPos
770+ <* updateLastForbiddenCharPos
572771 <?> "whitespace"
573772
574−linebreak :: OrgParser Inlines
575−linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline
773+linebreak :: OrgParser (F Inlines)
774+linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline
576775
577−str :: OrgParser Inlines
578−str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
579− <* updateLastStrPos
776+str :: OrgParser (F Inlines)
777+str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
778+ <* updateLastStrPos
580779
581−-- an endline character that can be treated as a space, not a structural break
582−endline :: OrgParser Inlines
780+-- | An endline character that can be treated as a space, not a structural
781+-- break. This should reflect the values of the Emacs variable
782+-- @org-element-pagaraph-separate@.
783+endline :: OrgParser (F Inlines)
583784endline = try $ do
584785 newline
585786 notFollowedBy blankline
586787 notFollowedBy' exampleLine
587788 notFollowedBy' hline
789+ notFollowedBy' noteMarker
588790 notFollowedBy' tableStart
589791 notFollowedBy' drawerStart
590792 notFollowedBy' headerStart
591793 notFollowedBy' metaLineStart
794+ notFollowedBy' latexEnvStart
592795 notFollowedBy' commentLineStart
593796 notFollowedBy' bulletListStart
594797 notFollowedBy' orderedListStart
595798 decEmphasisNewlinesCount
596799 guard =<< newlinesCountWithinLimits
597800 updateLastPreCharPos
598− return B.space
801+ return . return $ B.space
802+
803+footnote :: OrgParser (F Inlines)
804+footnote = try $ inlineNote <|> referencedNote
805+
806+inlineNote :: OrgParser (F Inlines)
807+inlineNote = try $ do
808+ string "[fn:"
809+ ref <- many alphaNum
810+ char ':'
811+ note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
812+ when (not $ null ref) $
813+ addToNotesTable ("fn:" ++ ref, note)
814+ return $ B.note <$> note
815+
816+referencedNote :: OrgParser (F Inlines)
817+referencedNote = try $ do
818+ ref <- noteMarker
819+ return $ do
820+ notes <- asksF orgStateNotes'
821+ case lookup ref notes of
822+ Nothing -> return $ B.str $ "[" ++ ref ++ "]"
823+ Just contents -> do
824+ st <- askF
825+ let contents' = runF contents st{ orgStateNotes' = [] }
826+ return $ B.note contents'
827+
828+noteMarker :: OrgParser String
829+noteMarker = try $ do
830+ char '['
831+ choice [ many1Till digit (char ']')
832+ , (++) <$> string "fn:"
833+ <*> many1Till (noneOf "\n\r\t ") (char ']')
834+ ]
599835
600−link :: OrgParser Inlines
601−link = explicitOrImageLink <|> selflinkOrImage <?> "link"
836+linkOrImage :: OrgParser (F Inlines)
837+linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"
602838
603−explicitOrImageLink :: OrgParser Inlines
839+explicitOrImageLink :: OrgParser (F Inlines)
604840explicitOrImageLink = try $ do
605841 char '['
606842 src <- linkTarget
607843 title <- enclosedRaw (char '[') (char ']')
608844 title' <- parseFromString (mconcat <$> many inline) title
609845 char ']'
610− return . B.link src ""
611− $ if isImageFilename src && isImageFilename title
612− then B.image title "" ""
613− else title'
846+ return $ B.link src "" <$>
847+ if isImageFilename src && isImageFilename title
848+ then return $ B.image title mempty mempty
849+ else title'
614850
615−selflinkOrImage :: OrgParser Inlines
851+selflinkOrImage :: OrgParser (F Inlines)
616852selflinkOrImage = try $ do
617853 src <- char '[' *> linkTarget <* char ']'
618− return $ if isImageFilename src
619− then B.image src "" ""
620− else B.link src "" (B.str src)
854+ return . return $ if isImageFilename src
855+ then B.image src "" ""
856+ else B.link src "" (B.str src)
621857
622858selfTarget :: OrgParser String
623859selfTarget = try $ char '[' *> linkTarget <* char ']'
@@ -628,57 +864,56 @@ linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")
628864isImageFilename :: String -> Bool
629865isImageFilename filename =
630866 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
631− any (\x -> (x++":") `isPrefixOf` filename) protocols ||
632− ':' `notElem` filename
867+ (any (\x -> (x++":") `isPrefixOf` filename) protocols ||
868+ ':' `notElem` filename)
633869 where
634870 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
635871 protocols = [ "file", "http", "https" ]
636872
637−emph :: OrgParser Inlines
638−emph = B.emph <$> emphasisBetween '/'
873+emph :: OrgParser (F Inlines)
874+emph = fmap B.emph <$> emphasisBetween '/'
639875
640−strong :: OrgParser Inlines
641−strong = B.strong <$> emphasisBetween '*'
876+strong :: OrgParser (F Inlines)
877+strong = fmap B.strong <$> emphasisBetween '*'
642878
643−strikeout :: OrgParser Inlines
644−strikeout = B.strikeout <$> emphasisBetween '+'
879+strikeout :: OrgParser (F Inlines)
880+strikeout = fmap B.strikeout <$> emphasisBetween '+'
645881
646882-- There is no underline, so we use strong instead.
647−underline :: OrgParser Inlines
648−underline = B.strong <$> emphasisBetween '_'
649−
650−code :: OrgParser Inlines
651−code = B.code <$> verbatimBetween '='
883+underline :: OrgParser (F Inlines)
884+underline = fmap B.strong <$> emphasisBetween '_'
652885
653−verbatim :: OrgParser Inlines
654−verbatim = B.rawInline "" <$> verbatimBetween '~'
886+code :: OrgParser (F Inlines)
887+code = return . B.code <$> verbatimBetween '='
655888
656−math :: OrgParser Inlines
657−math = B.math <$> choice [ math1CharBetween '$'
658− , mathStringBetween '$'
659− , rawMathBetween "\\(" "\\)"
660− ]
889+verbatim :: OrgParser (F Inlines)
890+verbatim = return . B.rawInline "" <$> verbatimBetween '~'
661891
662−displayMath :: OrgParser Inlines
663−displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
664− , rawMathBetween "$$" "$$"
665− ]
892+subscript :: OrgParser (F Inlines)
893+subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)
666894
667−subscript :: OrgParser Inlines
668−subscript = B.subscript <$> try (char '_' *> subOrSuperExpr)
895+superscript :: OrgParser (F Inlines)
896+superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)
669897
670−superscript :: OrgParser Inlines
671−superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)
898+math :: OrgParser (F Inlines)
899+math = return . B.math <$> choice [ math1CharBetween '$'
900+ , mathStringBetween '$'
901+ , rawMathBetween "\\(" "\\)"
902+ ]
672903
673−symbol :: OrgParser Inlines
674−symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
904+displayMath :: OrgParser (F Inlines)
905+displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
906+ , rawMathBetween "$$" "$$"
907+ ]
908+symbol :: OrgParser (F Inlines)
909+symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
675910 where updatePositions c
676911 | c `elem` emphasisPreChars = c <$ updateLastPreCharPos
677912 | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos
678913 | otherwise = return c
679914
680915emphasisBetween :: Char
681− -> OrgParser Inlines
916+ -> OrgParser (F Inlines)
682917emphasisBetween c = try $ do
683918 startEmphasisNewlinesCounting emphasisAllowedNewlines
684919 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
@@ -711,7 +946,7 @@ math1CharBetween c = try $ do
711946 char c
712947 res <- noneOf $ c:mathForbiddenBorderChars
713948 char c
714− eof <|> lookAhead (oneOf mathPostChars) *> return ()
949+ eof <|> () <$ lookAhead (oneOf mathPostChars)
715950 return [res]
716951
717952rawMathBetween :: String
@@ -734,12 +969,12 @@ emphasisEnd :: Char -> OrgParser Char
734969emphasisEnd c = try $ do
735970 guard =<< notAfterForbiddenBorderChar
736971 char c
737− eof <|> lookAhead (surroundingEmphasisChar >>= \x ->
738− oneOf (x ++ emphasisPostChars))
739− *> return ()
972+ eof <|> () <$ lookAhead acceptablePostChars
740973 updateLastStrPos
741974 popInlineCharStack
742975 return c
976+ where acceptablePostChars =
977+ surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)
743978
744979mathStart :: Char -> OrgParser Char
745980mathStart c = try $
@@ -749,15 +984,15 @@ mathEnd :: Char -> OrgParser Char
749984mathEnd c = try $ do
750985 res <- noneOf (c:mathForbiddenBorderChars)
751986 char c
752− eof <|> lookAhead (oneOf mathPostChars *> pure ())
987+ eof <|> () <$ lookAhead (oneOf mathPostChars)
753988 return res
754989
755990
756991enclosedInlines :: OrgParser a
757992 -> OrgParser b
758− -> OrgParser Inlines
993+ -> OrgParser (F Inlines)
759994enclosedInlines start end = try $
760− trimInlines . mconcat <$> enclosed start end inline
995+ trimInlinesF . mconcat <$> enclosed start end inline
761996
762997enclosedRaw :: OrgParser a
763998 -> OrgParser b
@@ -843,25 +1078,13 @@ notAfterForbiddenBorderChar = do
8431078 return $ lastFBCPos /= Just pos
8441079
8451080-- | Read a sub- or superscript expression
846−subOrSuperExpr :: OrgParser Inlines
847−subOrSuperExpr = try $ do
848− choice [ balancedSexp '{' '}'
849− , balancedSexp '(' ')' >>= return . enclosing ('(', ')')
1081+subOrSuperExpr :: OrgParser (F Inlines)
1082+subOrSuperExpr = try $
1083+ choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")
1084+ , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
8501085 , simpleSubOrSuperString
8511086 ] >>= parseFromString (mconcat <$> many inline)
852−
853−-- | Read a balanced sexp
854−balancedSexp :: Char
855− -> Char
856− -> OrgParser String
857−balancedSexp l r = try $ do
858− char l
859− res <- concat <$> many ( many1 (noneOf ([l, r] ++ "\n\r"))
860− <|> try (string [l, r])
861− <|> enclosing (l, r) <$> balancedSexp l r
862− )
863− char r
864− return res
1087+ where enclosing (left, right) s = left : s ++ [right]
8651088
8661089simpleSubOrSuperString :: OrgParser String
8671090simpleSubOrSuperString = try $
@@ -869,8 +1092,3 @@ simpleSubOrSuperString = try $
8691092 , mappend <$> option [] ((:[]) <$> oneOf "+-")
8701093 <*> many1 alphaNum
8711094 ]
872−
873−enclosing :: (a, a)
874− -> [a]
875− -> [a]
876−enclosing (left, right) s = left : s ++ [right]