@@ -1,6 +1,9 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
47{-
58Copyright (C) 2014 Albert Krewinkel <tarleb@moltkeplatz.de>
69
@@ -45,36 +48,52 @@ import Text.Pandoc.Shared (compactify', compactify'DL)
4548import Text.TeXMath (readTeX, writePandoc, DisplayType(..))
4649import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
4750
48−import Control.Applicative ( Applicative, pure
51+import Control.Applicative ( pure
4952 , (<$>), (<$), (<*>), (<*), (*>) )
5053import Control.Arrow (first)
51−import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)
52−import Control.Monad.Reader (Reader, runReader, ask, asks, local)
54+import Control.Monad (guard, mplus, mzero, when)
55+import Control.Monad.Reader (Reader, runReader, asks, local)
5356import Data.Char (isAlphaNum, toLower)
5457import Data.Default
55−import Data.List (intersperse, isPrefixOf, isSuffixOf)
58+import Data.List (intersperse, isPrefixOf, isSuffixOf, foldl')
5659import qualified Data.Map as M
5760import Data.Maybe (fromMaybe, isJust)
58−import Data.Monoid (Monoid, mconcat, mempty, mappend)
61+import Data.Monoid (mconcat, mempty, mappend)
5962import Network.HTTP (urlEncode)
6063
6164-- | Parse org-mode string and return a Pandoc document.
6265readOrg :: ReaderOptions -- ^ Reader options
6366 -> String -- ^ String to parse (assuming @'\n'@ line endings)
6467 -> Pandoc
65−readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")
68+readOrg opts s = runOrg opts s parseOrg
6669
67−data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }
70+data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext
71+ , finalState :: OrgParserState }
6872
6973type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)
7074
75+runOrg :: ReaderOptions -> String -> OrgParser a -> a
76+runOrg opts inp p = fst res
77+ where
78+ imd = readWithM (retState p) def{ orgStateOptions = opts } (inp ++ "\n\n")
79+ res = runReader imd def { finalState = s }
80+ s :: OrgParserState
81+ s = snd $ runReader imd (def { finalState = s })
82+
83+retState :: OrgParser a -> OrgParser (a, OrgParserState)
84+retState p = do
85+ r <- p
86+ s <- getState
87+ return (r, s)
88+
89+
7190parseOrg :: OrgParser Pandoc
7291parseOrg = do
7392 blocks' <- parseBlocks
7493 st <- getState
75− let meta = runF (orgStateMeta' st) st
94+ let meta = orgStateMeta st
7695 let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
77− return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)
96+ return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ blocks')
7897
7998-- | Drop COMMENT headers and the document tree below those headers.
8099dropCommentTrees :: [Block] -> [Block]
@@ -104,7 +123,7 @@ isHeaderLevelLowerEq n blk =
104123-- Parser State for Org
105124--
106125
107−type OrgNoteRecord = (String, F Blocks)
126+type OrgNoteRecord = (String, Blocks)
108127type OrgNoteTable = [OrgNoteRecord]
109128
110129type OrgBlockAttributes = M.Map String String
@@ -123,12 +142,11 @@ data OrgParserState = OrgParserState
123142 , orgStateLastStrPos :: Maybe SourcePos
124143 , orgStateLinkFormatters :: OrgLinkFormatters
125144 , orgStateMeta :: Meta
126− , orgStateMeta' :: F Meta
127145 , orgStateNotes' :: OrgNoteTable
128146 }
129147
130148instance Default OrgParserLocal where
131− def = OrgParserLocal NoQuote
149+ def = OrgParserLocal NoQuote def
132150
133151instance HasReaderOptions OrgParserState where
134152 extractReaderOptions = orgStateOptions
@@ -162,13 +180,13 @@ defaultOrgParserState = OrgParserState
162180 , orgStateLastStrPos = Nothing
163181 , orgStateLinkFormatters = M.empty
164182 , orgStateMeta = nullMeta
165− , orgStateMeta' = return nullMeta
166183 , orgStateNotes' = []
167184 }
168185
169186recordAnchorId :: String -> OrgParser ()
170187recordAnchorId i = updateState $ \s ->
171− s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
188+ let as = orgStateAnchorIds s in
189+ s{ orgStateAnchorIds = i : as }
172190
173191addBlockAttribute :: String -> String -> OrgParser ()
174192addBlockAttribute key val = updateState $ \s ->
@@ -247,30 +265,6 @@ parseFromString parser str' = do
247265-- Adaptions and specializations of parsing utilities
248266--
249267
250−newtype F a = F { unF :: Reader OrgParserState a
251− } deriving (Monad, Applicative, Functor)
252−
253−runF :: F a -> OrgParserState -> a
254−runF = runReader . unF
255−
256−askF :: F OrgParserState
257−askF = F ask
258−
259−asksF :: (OrgParserState -> a) -> F a
260−asksF f = F $ asks f
261−
262−instance Monoid a => Monoid (F a) where
263− mempty = return mempty
264− mappend = liftM2 mappend
265− mconcat = fmap mconcat . sequence
266−
267−trimInlinesF :: F Inlines -> F Inlines
268−trimInlinesF = liftM trimInlines
269−
270−returnF :: a -> OrgParser (F a)
271−returnF = return . return
272−
273−
274268-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.
275269newline :: OrgParser Char
276270newline =
@@ -289,10 +283,10 @@ blanklines =
289283-- parsing blocks
290284--
291285
292−parseBlocks :: OrgParser (F Blocks)
286+parseBlocks :: OrgParser Blocks
293287parseBlocks = mconcat <$> manyTill block eof
294288
295−block :: OrgParser (F Blocks)
289+block :: OrgParser Blocks
296290block = choice [ mempty <$ blanklines
297291 , optionalAttributes $ choice
298292 [ orgBlock
@@ -303,14 +297,14 @@ block = choice [ mempty <$ blanklines
303297 , drawer
304298 , specialLine
305299 , header
306− , return <$> hline
300+ , hline
307301 , list
308302 , latexFragment
309303 , noteBlock
310304 , paraOrPlain
311305 ] <?> "block"
312306
313−optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
307+optionalAttributes :: OrgParser Blocks -> OrgParser Blocks
314308optionalAttributes parser = try $
315309 resetBlockAttributes *> parseBlockAttributes *> parser
316310
@@ -330,7 +324,7 @@ parseAndAddAttribute key value = do
330324 let key' = map toLower key
331325 () <$ addBlockAttribute key' value
332326
333−lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
327+lookupInlinesAttr :: String -> OrgParser (Maybe Inlines)
334328lookupInlinesAttr attr = try $ do
335329 val <- lookupBlockAttribute attr
336330 maybe (return Nothing)
@@ -344,20 +338,20 @@ lookupInlinesAttr attr = try $ do
344338
345339type BlockProperties = (Int, String) -- (Indentation, Block-Type)
346340
347−orgBlock :: OrgParser (F Blocks)
341+orgBlock :: OrgParser Blocks
348342orgBlock = try $ do
349343 blockProp@(_, blkType) <- blockHeaderStart
350344 ($ blockProp) $
351345 case blkType of
352346 "comment" -> withRaw' (const mempty)
353− "html" -> withRaw' (return . (B.rawBlock blkType))
354− "latex" -> withRaw' (return . (B.rawBlock blkType))
355− "ascii" -> withRaw' (return . (B.rawBlock blkType))
356− "example" -> withRaw' (return . exampleCode)
357− "quote" -> withParsed (fmap B.blockQuote)
347+ "html" -> withRaw' (B.rawBlock blkType)
348+ "latex" -> withRaw' (B.rawBlock blkType)
349+ "ascii" -> withRaw' (B.rawBlock blkType)
350+ "example" -> withRaw' exampleCode
351+ "quote" -> withParsed B.blockQuote
358352 "verse" -> verseBlock
359353 "src" -> codeBlock
360− _ -> withParsed (fmap $ divWithClass blkType)
354+ _ -> withParsed (divWithClass blkType)
361355
362356blockHeaderStart :: OrgParser (Int, String)
363357blockHeaderStart = try $ (,) <$> indent <*> blockType
@@ -365,10 +359,10 @@ blockHeaderStart = try $ (,) <$> indent <*> blockType
365359 indent = length <$> many spaceChar
366360 blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)
367361
368−withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
362+withRaw' :: (String -> Blocks) -> BlockProperties -> OrgParser Blocks
369363withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))
370364
371−withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
365+withParsed :: (Blocks -> Blocks) -> BlockProperties -> OrgParser Blocks
372366withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))
373367
374368ignHeaders :: OrgParser ()
@@ -377,11 +371,11 @@ ignHeaders = (() <$ newline) <|> (() <$ anyLine)
377371divWithClass :: String -> Blocks -> Blocks
378372divWithClass cls = B.divWith ("", [cls], [])
379373
380−verseBlock :: BlockProperties -> OrgParser (F Blocks)
374+verseBlock :: BlockProperties -> OrgParser Blocks
381375verseBlock blkProp = try $ do
382376 ignHeaders
383377 content <- rawBlockContent blkProp
384− fmap B.para . mconcat . intersperse (pure B.linebreak)
378+ B.para . mconcat . intersperse B.linebreak
385379 <$> mapM (parseFromString parseInlines) (lines content)
386380
387381exportsCode :: [(String, String)] -> Bool
@@ -398,7 +392,7 @@ followingResultsBlock =
398392 *> blankline
399393 *> (unlines <$> many1 exampleLine))
400394
401−codeBlock :: BlockProperties -> OrgParser (F Blocks)
395+codeBlock :: BlockProperties -> OrgParser Blocks
402396codeBlock blkProp = do
403397 skipSpaces
404398 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
@@ -408,17 +402,15 @@ codeBlock blkProp = do
408402 let includeCode = exportsCode kv
409403 let includeResults = exportsResults kv
410404 let codeBlck = B.codeBlockWith ( id', classes, kv ) content
411− labelledBlck <- maybe (pure codeBlck)
412− (labelDiv codeBlck)
405+ labelledBlck <- maybe codeBlck (labelDiv codeBlck)
413406 <$> lookupInlinesAttr "caption"
414− let resultBlck = pure $ maybe mempty (exampleCode) resultsContent
407+ let resultBlck = maybe mempty exampleCode resultsContent
415408 return $ (if includeCode then labelledBlck else mempty)
416409 <> (if includeResults then resultBlck else mempty)
417410 where
418411 labelDiv blk value =
419− B.divWith nullAttr <$> (mappend <$> labelledBlock value
420− <*> pure blk)
421− labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
412+ B.divWith nullAttr (labelledBlock value <> blk)
413+ labelledBlock = B.plain . B.spanWith ("", ["label"], [])
422414
423415rawBlockContent :: BlockProperties -> OrgParser String
424416rawBlockContent (indent, blockType) = try $
@@ -427,7 +419,7 @@ rawBlockContent (indent, blockType) = try $
427419 indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)
428420 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
429421
430−parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
422+parsedBlockContent :: BlockProperties -> OrgParser Blocks
431423parsedBlockContent blkProps = try $ do
432424 raw <- rawBlockContent blkProps
433425 parseFromString parseBlocks (raw ++ "\n")
@@ -518,9 +510,9 @@ commaEscaped (',':cs@('*':_)) = cs
518510commaEscaped (',':cs@('#':'+':_)) = cs
519511commaEscaped cs = cs
520512
521−example :: OrgParser (F Blocks)
513+example :: OrgParser Blocks
522514example = try $ do
523− return . return . exampleCode =<< unlines <$> many1 exampleLine
515+ return . exampleCode =<< unlines <$> many1 exampleLine
524516
525517exampleCode :: String -> Blocks
526518exampleCode = B.codeBlockWith ("", ["example"], [])
@@ -529,7 +521,7 @@ exampleLine :: OrgParser String
529521exampleLine = try $ skipSpaces *> string ": " *> anyLine
530522
531523-- Drawers for properties or a logbook
532−drawer :: OrgParser (F Blocks)
524+drawer :: OrgParser Blocks
533525drawer = try $ do
534526 drawerStart
535527 manyTill drawerLine (try drawerEnd)
@@ -555,14 +547,12 @@ drawerEnd = try $
555547--
556548
557549-- Figures (Image on a line by itself, preceded by name and/or caption)
558−figure :: OrgParser (F Blocks)
550+figure :: OrgParser Blocks
559551figure = try $ do
560552 (cap, nam) <- nameAndCaption
561553 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline
562554 guard (isImageFilename src)
563− return $ do
564− cap' <- cap
565− return $ B.para $ B.image src nam cap'
555+ return $ B.para $ B.image src nam cap
566556 where
567557 nameAndCaption =
568558 do
@@ -578,8 +568,8 @@ figure = try $ do
578568
579569--
580570-- Comments, Options and Metadata
581−specialLine :: OrgParser (F Blocks)
582−specialLine = fmap return . try $ metaLine <|> commentLine
571+specialLine :: OrgParser Blocks
572+specialLine = try $ metaLine <|> commentLine
583573
584574metaLine :: OrgParser Blocks
585575metaLine = try $ mempty
@@ -599,14 +589,14 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
599589declarationLine :: OrgParser ()
600590declarationLine = try $ do
601591 key <- metaKey
602− inlinesF <- metaInlines
592+ inlines <- metaInlines
603593 updateState $ \st ->
604− let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta
605− in st { orgStateMeta' = orgStateMeta' st <> meta' }
594+ let meta' = B.setMeta key inlines nullMeta
595+ in st { orgStateMeta = orgStateMeta st <> meta' }
606596 return ()
607597
608−metaInlines :: OrgParser (F MetaValue)
609−metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
598+metaInlines :: OrgParser MetaValue
599+metaInlines = (MetaInlines . B.toList) <$> inlinesTillNewline
610600
611601metaKey :: OrgParser String
612602metaKey = map toLower <$> many1 (noneOf ": \n\r")
@@ -647,11 +637,11 @@ parseFormat = try $ do
647637--
648638
649639-- | Headers
650−header :: OrgParser (F Blocks)
640+header :: OrgParser Blocks
651641header = try $ do
652642 level <- headerStart
653643 title <- inlinesTillNewline
654− return $ B.header level <$> title
644+ return $ B.header level title
655645
656646headerStart :: OrgParser Int
657647headerStart = try $
@@ -675,7 +665,7 @@ hline = try $ do
675665-- Tables
676666--
677667
678−data OrgTableRow = OrgContentRow (F [Blocks])
668+data OrgTableRow = OrgContentRow [Blocks]
679669 | OrgAlignRow [Alignment]
680670 | OrgHlineRow
681671
@@ -686,13 +676,13 @@ data OrgTable = OrgTable
686676 , orgTableRows :: [[Blocks]]
687677 }
688678
689−table :: OrgParser (F Blocks)
679+table :: OrgParser Blocks
690680table = try $ do
691681 lookAhead tableStart
692682 do
693683 rows <- tableRows
694− cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
695− return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
684+ (cptn :: Inlines) <- fromMaybe "" <$> lookupInlinesAttr "caption"
685+ return $ ($ cptn) . orgToPandocTable . normalizeTable . rowsToTable $ rows
696686
697687orgToPandocTable :: OrgTable
698688 -> Inlines
@@ -708,11 +698,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
708698
709699tableContentRow :: OrgParser OrgTableRow
710700tableContentRow = try $
711− OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)
701+ OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)
712702
713−tableContentCell :: OrgParser (F Blocks)
703+tableContentCell :: OrgParser Blocks
714704tableContentCell = try $
715− fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell
705+ B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
716706
717707endOfCell :: OrgParser Char
718708endOfCell = try $ char '|' <|> lookAhead newline
@@ -744,8 +734,8 @@ tableHline = try $
744734 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
745735
746736rowsToTable :: [OrgTableRow]
747− -> F OrgTable
748−rowsToTable = foldM (flip rowToContent) zeroTable
737+ -> OrgTable
738+rowsToTable = foldl' (flip rowToContent) zeroTable
749739 where zeroTable = OrgTable 0 mempty mempty mempty
750740
751741normalizeTable :: OrgTable
@@ -764,45 +754,43 @@ normalizeTable (OrgTable cols aligns heads lns) =
764754-- line as a header. All other horizontal lines are discarded.
765755rowToContent :: OrgTableRow
766756 -> OrgTable
767− -> F OrgTable
757+ -> OrgTable
768758rowToContent OrgHlineRow t = maybeBodyToHeader t
769−rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t
770−rowToContent (OrgContentRow rf) t = do
771− rs <- rf
772− setLongestRow rs =<< appendToBody rs t
759+rowToContent (OrgAlignRow as) t = setLongestRow as . setAligns as $ t
760+rowToContent (OrgContentRow rf) t = setLongestRow rf . appendToBody rf $ t
773761
774762setLongestRow :: [a]
775763 -> OrgTable
776− -> F OrgTable
764+ -> OrgTable
777765setLongestRow rs t =
778− return t{ orgTableColumns = max (length rs) (orgTableColumns t) }
766+ t{ orgTableColumns = max (length rs) (orgTableColumns t) }
779767
780768maybeBodyToHeader :: OrgTable
781− -> F OrgTable
769+ -> OrgTable
782770maybeBodyToHeader t = case t of
783771 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
784− return t{ orgTableHeader = b , orgTableRows = [] }
785− _ -> return t
772+ t{ orgTableHeader = b , orgTableRows = [] }
773+ _ -> t
786774
787775appendToBody :: [Blocks]
788776 -> OrgTable
789− -> F OrgTable
790−appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }
777+ -> OrgTable
778+appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
791779
792780setAligns :: [Alignment]
793781 -> OrgTable
794− -> F OrgTable
795−setAligns aligns t = return $ t{ orgTableAlignments = aligns }
782+ -> OrgTable
783+setAligns aligns t = t{ orgTableAlignments = aligns }
796784
797785
798786--
799787-- LaTeX fragments
800788--
801−latexFragment :: OrgParser (F Blocks)
789+latexFragment :: OrgParser Blocks
802790latexFragment = try $ do
803791 envName <- latexEnvStart
804792 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)
805− return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)
793+ return $ B.rawBlock "latex" (content `inLatexEnv` envName)
806794 where
807795 c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"
808796 , c
@@ -832,7 +820,7 @@ latexEnvName = try $ do
832820--
833821-- Footnote defintions
834822--
835−noteBlock :: OrgParser (F Blocks)
823+noteBlock :: OrgParser Blocks
836824noteBlock = try $ do
837825 ref <- noteMarker <* skipSpaces
838826 content <- mconcat <$> blocksTillHeaderOrNote
@@ -844,37 +832,37 @@ noteBlock = try $ do
844832 <|> () <$ lookAhead headerStart)
845833
846834-- Paragraphs or Plain text
847−paraOrPlain :: OrgParser (F Blocks)
835+paraOrPlain :: OrgParser Blocks
848836paraOrPlain = try $ do
849837 ils <- parseInlines
850838 nl <- option False (newline >> return True)
851839 try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>
852− return (B.para <$> ils))
853− <|> (return (B.plain <$> ils))
840+ (return $ B.para ils))
841+ <|> (return $ B.plain ils)
854842
855−inlinesTillNewline :: OrgParser (F Inlines)
856−inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
843+inlinesTillNewline :: OrgParser Inlines
844+inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline
857845
858846
859847--
860848-- list blocks
861849--
862850
863−list :: OrgParser (F Blocks)
851+list :: OrgParser Blocks
864852list = choice [ definitionList, bulletList, orderedList ] <?> "list"
865853
866−definitionList :: OrgParser (F Blocks)
854+definitionList :: OrgParser Blocks
867855definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)
868− fmap B.definitionList . fmap compactify'DL . sequence
856+ B.definitionList . compactify'DL
869857 <$> many1 (definitionListItem $ bulletListStart' (Just n))
870858
871−bulletList :: OrgParser (F Blocks)
859+bulletList :: OrgParser Blocks
872860bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)
873− fmap B.bulletList . fmap compactify' . sequence
861+ B.bulletList . compactify'
874862 <$> many1 (listItem (bulletListStart' $ Just n))
875863
876−orderedList :: OrgParser (F Blocks)
877−orderedList = fmap B.orderedList . fmap compactify' . sequence
864+orderedList :: OrgParser Blocks
865+orderedList = B.orderedList . compactify'
878866 <$> many1 (listItem orderedListStart)
879867
880868genericListStart :: OrgParser String
@@ -911,7 +899,7 @@ orderedListStart = genericListStart orderedListMarker
911899 where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
912900
913901definitionListItem :: OrgParser Int
914− -> OrgParser (F (Inlines, [Blocks]))
902+ -> OrgParser (Inlines, [Blocks])
915903definitionListItem parseMarkerGetLength = try $ do
916904 markerLength <- parseMarkerGetLength
917905 term <- manyTill (noneOf "\n\r") (try $ string "::")
@@ -920,12 +908,12 @@ definitionListItem parseMarkerGetLength = try $ do
920908 cont <- concat <$> many (listContinuation markerLength)
921909 term' <- parseFromString parseInlines term
922910 contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont
923− return $ (,) <$> term' <*> fmap (:[]) contents'
911+ return (term', [contents'])
924912
925913
926914-- parse raw text for one list item, excluding start marker and continuations
927915listItem :: OrgParser Int
928− -> OrgParser (F Blocks)
916+ -> OrgParser Blocks
929917listItem start = try $ do
930918 markerLength <- try start
931919 firstLine <- anyLineNewline
@@ -951,7 +939,7 @@ anyLineNewline = (++ "\n") <$> anyLine
951939-- inline
952940--
953941
954−inline :: OrgParser (F Inlines)
942+inline :: OrgParser Inlines
955943inline =
956944 choice [ whitespace
957945 , linebreak
@@ -978,31 +966,31 @@ inline =
978966 ] <* (guard =<< newlinesCountWithinLimits)
979967 <?> "inline"
980968
981−parseInlines :: OrgParser (F Inlines)
982−parseInlines = trimInlinesF . mconcat <$> many1 inline
969+parseInlines :: OrgParser Inlines
970+parseInlines = trimInlines . mconcat <$> many1 inline
983971
984972-- treat these as potentially non-text when parsing inline:
985973specialChars :: [Char]
986974specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"
987975
988976
989−whitespace :: OrgParser (F Inlines)
990−whitespace = pure B.space <$ skipMany1 spaceChar
977+whitespace :: OrgParser Inlines
978+whitespace = B.space <$ skipMany1 spaceChar
991979 <* updateLastPreCharPos
992980 <* updateLastForbiddenCharPos
993981 <?> "whitespace"
994982
995−linebreak :: OrgParser (F Inlines)
996−linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline
983+linebreak :: OrgParser Inlines
984+linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline
997985
998−str :: OrgParser (F Inlines)
999−str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
986+str :: OrgParser Inlines
987+str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")
1000988 <* updateLastStrPos
1001989
1002990-- | An endline character that can be treated as a space, not a structural
1003991-- break. This should reflect the values of the Emacs variable
1004992-- @org-element-pagaraph-separate@.
1005−endline :: OrgParser (F Inlines)
993+endline :: OrgParser Inlines
1006994endline = try $ do
1007995 newline
1008996 notFollowedBy blankline
@@ -1020,77 +1008,72 @@ endline = try $ do
10201008 decEmphasisNewlinesCount
10211009 guard =<< newlinesCountWithinLimits
10221010 updateLastPreCharPos
1023− return . return $ B.space
1011+ return $ B.space
10241012
1025−cite :: OrgParser (F Inlines)
1013+cite :: OrgParser Inlines
10261014cite = try $ do
10271015 guardEnabled Ext_citations
10281016 (cs, raw) <- withRaw normalCite
1029− return $ (flip B.cite (B.text raw)) <$> cs
1017+ return $ flip B.cite (B.text raw) cs
10301018
1031−normalCite :: OrgParser (F [Citation])
1019+normalCite :: OrgParser [Citation]
10321020normalCite = try $ char '['
10331021 *> skipSpaces
10341022 *> citeList
10351023 <* skipSpaces
10361024 <* char ']'
10371025
1038−citeList :: OrgParser (F [Citation])
1039−citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)
1026+citeList :: OrgParser [Citation]
1027+citeList = sepBy1 citation (try $ char ';' *> skipSpaces)
10401028
1041−citation :: OrgParser (F Citation)
1029+citation :: OrgParser Citation
10421030citation = try $ do
10431031 pref <- prefix
10441032 (suppress_author, key) <- citeKey
10451033 suff <- suffix
1046− return $ do
1047− x <- pref
1048− y <- suff
1049− return $ Citation{ citationId = key
1050− , citationPrefix = B.toList x
1051− , citationSuffix = B.toList y
1052− , citationMode = if suppress_author
1053− then SuppressAuthor
1054− else NormalCitation
1055− , citationNoteNum = 0
1056− , citationHash = 0
1057− }
1034+ return $ Citation{ citationId = key
1035+ , citationPrefix = B.toList pref
1036+ , citationSuffix = B.toList suff
1037+ , citationMode = if suppress_author
1038+ then SuppressAuthor
1039+ else NormalCitation
1040+ , citationNoteNum = 0
1041+ , citationHash = 0
1042+ }
10581043 where
1059− prefix = trimInlinesF . mconcat <$>
1044+ prefix = trimInlines . mconcat <$>
10601045 manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))
10611046 suffix = try $ do
10621047 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)
10631048 skipSpaces
1064− rest <- trimInlinesF . mconcat <$>
1049+ rest <- trimInlines . mconcat <$>
10651050 many (notFollowedBy (oneOf ";]") *> inline)
1066− return $ if hasSpace
1067− then (B.space <>) <$> rest
1068− else rest
1051+ return $
1052+ if hasSpace
1053+ then B.space <> rest
1054+ else rest
10691055
1070−footnote :: OrgParser (F Inlines)
1056+footnote :: OrgParser Inlines
10711057footnote = try $ inlineNote <|> referencedNote
10721058
1073−inlineNote :: OrgParser (F Inlines)
1059+inlineNote :: OrgParser Inlines
10741060inlineNote = try $ do
10751061 string "[fn:"
10761062 ref <- many alphaNum
10771063 char ':'
1078− note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
1064+ note <- B.para . trimInlines . mconcat <$> many1Till inline (char ']')
10791065 when (not $ null ref) $
10801066 addToNotesTable ("fn:" ++ ref, note)
1081− return $ B.note <$> note
1067+ return $ B.note note
10821068
1083−referencedNote :: OrgParser (F Inlines)
1069+referencedNote :: OrgParser Inlines
10841070referencedNote = try $ do
10851071 ref <- noteMarker
1086− return $ do
1087− notes <- asksF orgStateNotes'
1072+ notes <- asks (orgStateNotes' . finalState)
1073+ return $
10881074 case lookup ref notes of
1089− Nothing -> return $ B.str $ "[" ++ ref ++ "]"
1090− Just contents -> do
1091− st <- askF
1092− let contents' = runF contents st{ orgStateNotes' = [] }
1093− return $ B.note contents'
1075+ Just contents -> B.note contents
1076+ Nothing -> B.str $ "[" ++ ref ++ "]"
10941077
10951078noteMarker :: OrgParser String
10961079noteMarker = try $ do
@@ -1100,37 +1083,37 @@ noteMarker = try $ do
11001083 <*> many1Till (noneOf "\n\r\t ") (char ']')
11011084 ]
11021085
1103−linkOrImage :: OrgParser (F Inlines)
1086+linkOrImage :: OrgParser Inlines
11041087linkOrImage = explicitOrImageLink
11051088 <|> selflinkOrImage
11061089 <|> angleLink
11071090 <|> plainLink
11081091 <?> "link or image"
11091092
1110−explicitOrImageLink :: OrgParser (F Inlines)
1093+explicitOrImageLink :: OrgParser Inlines
11111094explicitOrImageLink = try $ do
11121095 char '['
1113− srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget
1096+ src <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget
11141097 title <- enclosedRaw (char '[') (char ']')
11151098 title' <- parseFromString (mconcat <$> many inline) title
11161099 char ']'
1117− return $ do
1118− src <- srcF
1119− if isImageFilename src && isImageFilename title
1120− then pure $ B.link src "" $ B.image title mempty mempty
1121− else linkToInlinesF src =<< title'
1100+ alt <- internalLink src title'
1101+ return $
1102+ (if isImageFilename src && isImageFilename title
1103+ then B.link src "" $ B.image title mempty mempty
1104+ else fromMaybe alt (linkToInlines src title'))
11221105
1123−selflinkOrImage :: OrgParser (F Inlines)
1106+selflinkOrImage :: OrgParser Inlines
11241107selflinkOrImage = try $ do
11251108 src <- char '[' *> linkTarget <* char ']'
1126− return $ linkToInlinesF src (B.str src)
1109+ return $ fromMaybe "" (linkToInlines src (B.str src))
11271110
1128−plainLink :: OrgParser (F Inlines)
1111+plainLink :: OrgParser Inlines
11291112plainLink = try $ do
11301113 (orig, src) <- uri
1131− returnF $ B.link src "" (B.str orig)
1114+ return $ B.link src "" (B.str orig)
11321115
1133−angleLink :: OrgParser (F Inlines)
1116+angleLink :: OrgParser Inlines
11341117angleLink = try $ do
11351118 char '<'
11361119 link <- plainLink
@@ -1146,26 +1129,31 @@ linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")
11461129possiblyEmptyLinkTarget :: OrgParser String
11471130possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")
11481131
1149−applyCustomLinkFormat :: String -> OrgParser (F String)
1132+applyCustomLinkFormat :: String -> OrgParser String
11501133applyCustomLinkFormat link = do
11511134 let (linkType, rest) = break (== ':') link
1152− return $ do
1153− formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters
1154− return $ maybe link ($ drop 1 rest) formatter
1135+ fmts <- asks finalState
1136+ return $
1137+ case M.lookup linkType (orgStateLinkFormatters fmts) of
1138+ Just v -> (v (drop 1 rest))
1139+ Nothing -> link
11551140
11561141-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind
11571142-- of parsing.
1158−linkToInlinesF :: String -> Inlines -> F Inlines
1159−linkToInlinesF s =
1143+linkToInlines :: String -> Inlines -> Maybe Inlines
1144+linkToInlines = \s ->
11601145 case s of
1161− "" -> pure . B.link "" ""
1162− ('#':_) -> pure . B.link s ""
1163− _ | isImageFilename s -> const . pure $ B.image s "" ""
1164− _ | isFileLink s -> pure . B.link (dropLinkType s) ""
1165− _ | isUri s -> pure . B.link s ""
1166− _ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""
1167− _ | isRelativeFilePath s -> pure . B.link s ""
1168− _ -> internalLink s
1146+ _ | null s -> Just . B.link "" ""
1147+ _ | isAnchor s -> Just . B.link s ""
1148+ _ | isImageFilename s -> const . Just $ B.image s "" ""
1149+ _ | isFileLink s -> Just . B.link (dropLinkType s) ""
1150+ _ | isUri s -> Just . B.link s ""
1151+ _ | isAbsoluteFilePath s -> Just . B.link ("file://" ++ s) ""
1152+ _ | isRelativeFilePath s -> Just . B.link s ""
1153+ _ -> const Nothing
1154+
1155+isAnchor :: String -> Bool
1156+isAnchor s = "#" `isPrefixOf` s
11691157
11701158isFileLink :: String -> Bool
11711159isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)
@@ -1194,12 +1182,13 @@ isImageFilename filename =
11941182 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
11951183 protocols = [ "file", "http", "https" ]
11961184
1197−internalLink :: String -> Inlines -> F Inlines
1185+internalLink :: String -> Inlines -> OrgParser Inlines
11981186internalLink link title = do
1199− anchorB <- (link `elem`) <$> asksF orgStateAnchorIds
1200− if anchorB
1201− then return $ B.link ('#':link) "" title
1202− else return $ B.emph title
1187+ anchorB <- asks finalState
1188+ return $
1189+ if link `elem` (orgStateAnchorIds anchorB)
1190+ then B.link ('#':link) "" title
1191+ else B.emph title
12031192
12041193-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with
12051194-- @anchor-id@ set as id. Legal anchors in org-mode are defined through
@@ -1207,11 +1196,11 @@ internalLink link title = do
12071196-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as
12081197-- an anchor.
12091198
1210−anchor :: OrgParser (F Inlines)
1199+anchor :: OrgParser Inlines
12111200anchor = try $ do
12121201 anchorId <- parseAnchor
12131202 recordAnchorId anchorId
1214− returnF $ B.spanWith (solidify anchorId, [], []) mempty
1203+ return $ B.spanWith (solidify anchorId, [], []) mempty
12151204 where
12161205 parseAnchor = string "<<"
12171206 *> many1 (noneOf "\t\n\r<>\"' ")
@@ -1229,7 +1218,7 @@ solidify = map replaceSpecialChar
12291218 | otherwise = '-'
12301219
12311220-- | Parses an inline code block and marks it as an babel block.
1232−inlineCodeBlock :: OrgParser (F Inlines)
1221+inlineCodeBlock :: OrgParser Inlines
12331222inlineCodeBlock = try $ do
12341223 string "src_"
12351224 lang <- many1 orgArgWordChar
@@ -1237,7 +1226,7 @@ inlineCodeBlock = try $ do
12371226 inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")
12381227 let attrClasses = [translateLang lang, rundocBlockClass]
12391228 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)
1240− returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
1229+ return $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
12411230
12421231enclosedByPair :: Char -- ^ opening char
12431232 -> Char -- ^ closing char
@@ -1245,41 +1234,40 @@ enclosedByPair :: Char -- ^ opening char
12451234 -> OrgParser [a]
12461235enclosedByPair s e p = char s *> many1Till p (char e)
12471236
1248−emph :: OrgParser (F Inlines)
1249−emph = fmap B.emph <$> emphasisBetween '/'
1237+emph :: OrgParser Inlines
1238+emph = B.emph <$> emphasisBetween '/'
12501239
1251−strong :: OrgParser (F Inlines)
1252−strong = fmap B.strong <$> emphasisBetween '*'
1240+strong :: OrgParser Inlines
1241+strong = B.strong <$> emphasisBetween '*'
12531242
1254−strikeout :: OrgParser (F Inlines)
1255−strikeout = fmap B.strikeout <$> emphasisBetween '+'
1243+strikeout :: OrgParser Inlines
1244+strikeout = B.strikeout <$> emphasisBetween '+'
12561245
12571246-- There is no underline, so we use strong instead.
1258−underline :: OrgParser (F Inlines)
1259−underline = fmap B.strong <$> emphasisBetween '_'
1247+underline :: OrgParser Inlines
1248+underline = B.strong <$> emphasisBetween '_'
12601249
1261−verbatim :: OrgParser (F Inlines)
1262−verbatim = return . B.code <$> verbatimBetween '='
1250+verbatim :: OrgParser Inlines
1251+verbatim = B.code <$> verbatimBetween '='
12631252
1264−code :: OrgParser (F Inlines)
1265−code = return . B.code <$> verbatimBetween '~'
1253+code :: OrgParser Inlines
1254+code = B.code <$> verbatimBetween '~'
12661255
1267−subscript :: OrgParser (F Inlines)
1268−subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)
1256+subscript :: OrgParser Inlines
1257+subscript = B.subscript <$> try (char '_' *> subOrSuperExpr)
12691258
1270−superscript :: OrgParser (F Inlines)
1271−superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)
1259+superscript :: OrgParser Inlines
1260+superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)
12721261
1273−math :: OrgParser (F Inlines)
1274−math = return . B.math <$> choice [ math1CharBetween '$'
1262+math :: OrgParser Inlines
1263+math = B.math <$> choice [ math1CharBetween '$'
12751264 , mathStringBetween '$'
12761265 , rawMathBetween "\\(" "\\)"
12771266 ]
12781267
1279−displayMath :: OrgParser (F Inlines)
1280−displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
1281− , rawMathBetween "$$" "$$"
1282− ]
1268+displayMath :: OrgParser Inlines
1269+displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"
1270+ , rawMathBetween "$$" "$$" ]
12831271
12841272updatePositions :: Char
12851273 -> OrgParser (Char)
@@ -1288,11 +1276,11 @@ updatePositions c = do
12881276 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos
12891277 return c
12901278
1291−symbol :: OrgParser (F Inlines)
1292−symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
1279+symbol :: OrgParser Inlines
1280+symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)
12931281
12941282emphasisBetween :: Char
1295− -> OrgParser (F Inlines)
1283+ -> OrgParser Inlines
12961284emphasisBetween c = try $ do
12971285 startEmphasisNewlinesCounting emphasisAllowedNewlines
12981286 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)
@@ -1369,9 +1357,9 @@ mathEnd c = try $ do
13691357
13701358enclosedInlines :: OrgParser a
13711359 -> OrgParser b
1372− -> OrgParser (F Inlines)
1360+ -> OrgParser Inlines
13731361enclosedInlines start end = try $
1374− trimInlinesF . mconcat <$> enclosed start end inline
1362+ trimInlines . mconcat <$> enclosed start end inline
13751363
13761364enclosedRaw :: OrgParser a
13771365 -> OrgParser b
@@ -1450,7 +1438,7 @@ notAfterForbiddenBorderChar = do
14501438 return $ lastFBCPos /= Just pos
14511439
14521440-- | Read a sub- or superscript expression
1453−subOrSuperExpr :: OrgParser (F Inlines)
1441+subOrSuperExpr :: OrgParser Inlines
14541442subOrSuperExpr = try $
14551443 choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")
14561444 , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
@@ -1465,10 +1453,10 @@ simpleSubOrSuperString = try $
14651453 <*> many1 alphaNum
14661454 ]
14671455
1468−inlineLaTeX :: OrgParser (F Inlines)
1456+inlineLaTeX :: OrgParser Inlines
14691457inlineLaTeX = try $ do
14701458 cmd <- inlineLaTeXCommand
1471− maybe mzero returnF $
1459+ maybe mzero return $
14721460 parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd
14731461 where
14741462 parseAsMath :: String -> Maybe Inlines
@@ -1501,30 +1489,30 @@ inlineLaTeXCommand = try $ do
15011489 return cs
15021490 _ -> mzero
15031491
1504−smart :: OrgParser (F Inlines)
1492+smart :: OrgParser Inlines
15051493smart = do
15061494 getOption readerSmart >>= guard
15071495 doubleQuoted <|> singleQuoted <|>
1508− choice (map (return <$>) [orgApostrophe, dash, ellipses])
1496+ choice [orgApostrophe, dash, ellipses]
15091497 where orgApostrophe =
15101498 (char '\'' <|> char '\8217') <* updateLastPreCharPos
15111499 <* updateLastForbiddenCharPos
15121500 *> return (B.str "\x2019")
15131501
1514−singleQuoted :: OrgParser (F Inlines)
1502+singleQuoted :: OrgParser Inlines
15151503singleQuoted = try $ do
15161504 singleQuoteStart
15171505 withQuoteContext InSingleQuote $
1518− fmap B.singleQuoted . trimInlinesF . mconcat <$>
1506+ B.singleQuoted . trimInlines . mconcat <$>
15191507 many1Till inline singleQuoteEnd
15201508
15211509-- doubleQuoted will handle regular double-quoted sections, as well
15221510-- as dialogues with an open double-quote without a close double-quote
15231511-- in the same paragraph.
1524−doubleQuoted :: OrgParser (F Inlines)
1512+doubleQuoted :: OrgParser Inlines
15251513doubleQuoted = try $ do
15261514 doubleQuoteStart
15271515 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
15281516 (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return
1529− (fmap B.doubleQuoted . trimInlinesF $ contents))
1530− <|> (return $ return (B.str "\8220") <> contents)
1517+ (B.doubleQuoted . trimInlines $ contents))
1518+ <|> (return $ (B.str "\8220") <> contents)