f6419a2 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Remove F monad from Org Reader.

f6419a2Matthew Pickering12 years ago

src/Text/Pandoc/Readers/Org.hs+227−239

compare with master

unifiedsplit

@@ -1,6 +1,9 @@

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE MultiParamTypeClasses #-}

4{-

7{-

@@ -45,36 +48,52 @@ import Text.Pandoc.Shared (compactify', compactify'DL)

45import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

48import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

46import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

49import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

48−import Control.Applicative ( Applicative, pure

51+import Control.Applicative ( pure

49 , (<$>), (<$), (<*>), (<*), (*>) )

52 , (<$>), (<$), (<*>), (<*), (*>) )

50import Control.Arrow (first)

53import Control.Arrow (first)

51−import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)

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

52−import Control.Monad.Reader (Reader, runReader, ask, asks, local)

55+import Control.Monad.Reader (Reader, runReader, asks, local)

53import Data.Char (isAlphaNum, toLower)

56import Data.Char (isAlphaNum, toLower)

54import Data.Default

57import Data.Default

55−import Data.List (intersperse, isPrefixOf, isSuffixOf)

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

56import qualified Data.Map as M

59import qualified Data.Map as M

57import Data.Maybe (fromMaybe, isJust)

60import Data.Maybe (fromMaybe, isJust)

58−import Data.Monoid (Monoid, mconcat, mempty, mappend)

61+import Data.Monoid (mconcat, mempty, mappend)

59import Network.HTTP (urlEncode)

62import Network.HTTP (urlEncode)

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

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

62readOrg :: ReaderOptions -- ^ Reader options

65readOrg :: ReaderOptions -- ^ Reader options

63 -> String -- ^ String to parse (assuming @'\n'@ line endings)

66 -> String -- ^ String to parse (assuming @'\n'@ line endings)

64 -> Pandoc

67 -> Pandoc

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

68+readOrg opts s = runOrg opts s parseOrg

67−data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }

70+data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

71+ , finalState :: OrgParserState }

69type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

73type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

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+

71parseOrg :: OrgParser Pandoc

90parseOrg :: OrgParser Pandoc

72parseOrg = do

91parseOrg = do

73 blocks' <- parseBlocks

92 blocks' <- parseBlocks

74 st <- getState

93 st <- getState

75− let meta = runF (orgStateMeta' st) st

94+ let meta = orgStateMeta st

76 let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

95 let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

77− return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)

96+ return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ blocks')

79-- | Drop COMMENT headers and the document tree below those headers.

98-- | Drop COMMENT headers and the document tree below those headers.

80dropCommentTrees :: [Block] -> [Block]

99dropCommentTrees :: [Block] -> [Block]

@@ -104,7 +123,7 @@ isHeaderLevelLowerEq n blk =

104-- Parser State for Org

123-- Parser State for Org

105--

124--

106

125

107−type OrgNoteRecord = (String, F Blocks)

126+type OrgNoteRecord = (String, Blocks)

108type OrgNoteTable = [OrgNoteRecord]

127type OrgNoteTable = [OrgNoteRecord]

109

128

110type OrgBlockAttributes = M.Map String String

129type OrgBlockAttributes = M.Map String String

@@ -123,12 +142,11 @@ data OrgParserState = OrgParserState

123 , orgStateLastStrPos :: Maybe SourcePos

142 , orgStateLastStrPos :: Maybe SourcePos

124 , orgStateLinkFormatters :: OrgLinkFormatters

143 , orgStateLinkFormatters :: OrgLinkFormatters

125 , orgStateMeta :: Meta

144 , orgStateMeta :: Meta

126− , orgStateMeta' :: F Meta

127 , orgStateNotes' :: OrgNoteTable

145 , orgStateNotes' :: OrgNoteTable

128 }

146 }

129

147

130instance Default OrgParserLocal where

148instance Default OrgParserLocal where

131− def = OrgParserLocal NoQuote

149+ def = OrgParserLocal NoQuote def

132

150

133instance HasReaderOptions OrgParserState where

151instance HasReaderOptions OrgParserState where

134 extractReaderOptions = orgStateOptions

152 extractReaderOptions = orgStateOptions

@@ -162,13 +180,13 @@ defaultOrgParserState = OrgParserState

162 , orgStateLastStrPos = Nothing

180 , orgStateLastStrPos = Nothing

163 , orgStateLinkFormatters = M.empty

181 , orgStateLinkFormatters = M.empty

164 , orgStateMeta = nullMeta

182 , orgStateMeta = nullMeta

165− , orgStateMeta' = return nullMeta

166 , orgStateNotes' = []

183 , orgStateNotes' = []

167 }

184 }

168

185

169recordAnchorId :: String -> OrgParser ()

186recordAnchorId :: String -> OrgParser ()

170recordAnchorId i = updateState $ \s ->

187recordAnchorId i = updateState $ \s ->

188+ let as = orgStateAnchorIds s in

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

189+ s{ orgStateAnchorIds = i : as }

172

190

173addBlockAttribute :: String -> String -> OrgParser ()

191addBlockAttribute :: String -> String -> OrgParser ()

174addBlockAttribute key val = updateState $ \s ->

192addBlockAttribute key val = updateState $ \s ->

@@ -247,30 +265,6 @@ parseFromString parser str' = do

247-- Adaptions and specializations of parsing utilities

265-- Adaptions and specializations of parsing utilities

248--

266--

249

267

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−

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

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

275newline :: OrgParser Char

269newline :: OrgParser Char

276newline =

270newline =

@@ -289,10 +283,10 @@ blanklines =

289-- parsing blocks

283-- parsing blocks

290--

284--

291

285

292−parseBlocks :: OrgParser (F Blocks)

286+parseBlocks :: OrgParser Blocks

293parseBlocks = mconcat <$> manyTill block eof

287parseBlocks = mconcat <$> manyTill block eof

294

288

295−block :: OrgParser (F Blocks)

289+block :: OrgParser Blocks

296block = choice [ mempty <$ blanklines

290block = choice [ mempty <$ blanklines

297 , optionalAttributes $ choice

291 , optionalAttributes $ choice

298 [ orgBlock

292 [ orgBlock

@@ -303,14 +297,14 @@ block = choice [ mempty <$ blanklines

303 , drawer

297 , drawer

304 , specialLine

298 , specialLine

305 , header

299 , header

306− , return <$> hline

300+ , hline

307 , list

301 , list

308 , latexFragment

302 , latexFragment

309 , noteBlock

303 , noteBlock

310 , paraOrPlain

304 , paraOrPlain

311 ] <?> "block"

305 ] <?> "block"

312

306

313−optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)

307+optionalAttributes :: OrgParser Blocks -> OrgParser Blocks

314optionalAttributes parser = try $

308optionalAttributes parser = try $

315 resetBlockAttributes *> parseBlockAttributes *> parser

309 resetBlockAttributes *> parseBlockAttributes *> parser

316

310

@@ -330,7 +324,7 @@ parseAndAddAttribute key value = do

330 let key' = map toLower key

324 let key' = map toLower key

331 () <$ addBlockAttribute key' value

325 () <$ addBlockAttribute key' value

332

326

333−lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))

327+lookupInlinesAttr :: String -> OrgParser (Maybe Inlines)

334lookupInlinesAttr attr = try $ do

328lookupInlinesAttr attr = try $ do

335 val <- lookupBlockAttribute attr

329 val <- lookupBlockAttribute attr

336 maybe (return Nothing)

330 maybe (return Nothing)

@@ -344,20 +338,20 @@ lookupInlinesAttr attr = try $ do

344

338

345type BlockProperties = (Int, String) -- (Indentation, Block-Type)

339type BlockProperties = (Int, String) -- (Indentation, Block-Type)

346

340

347−orgBlock :: OrgParser (F Blocks)

341+orgBlock :: OrgParser Blocks

348orgBlock = try $ do

342orgBlock = try $ do

349 blockProp@(_, blkType) <- blockHeaderStart

343 blockProp@(_, blkType) <- blockHeaderStart

350 ($ blockProp) $

344 ($ blockProp) $

351 case blkType of

345 case blkType of

352 "comment" -> withRaw' (const mempty)

346 "comment" -> withRaw' (const mempty)

353− "html" -> withRaw' (return . (B.rawBlock blkType))

347+ "html" -> withRaw' (B.rawBlock blkType)

354− "latex" -> withRaw' (return . (B.rawBlock blkType))

348+ "latex" -> withRaw' (B.rawBlock blkType)

355− "ascii" -> withRaw' (return . (B.rawBlock blkType))

349+ "ascii" -> withRaw' (B.rawBlock blkType)

356− "example" -> withRaw' (return . exampleCode)

350+ "example" -> withRaw' exampleCode

357− "quote" -> withParsed (fmap B.blockQuote)

351+ "quote" -> withParsed B.blockQuote

358 "verse" -> verseBlock

352 "verse" -> verseBlock

359 "src" -> codeBlock

353 "src" -> codeBlock

360− _ -> withParsed (fmap $ divWithClass blkType)

354+ _ -> withParsed (divWithClass blkType)

361

355

362blockHeaderStart :: OrgParser (Int, String)

356blockHeaderStart :: OrgParser (Int, String)

363blockHeaderStart = try $ (,) <$> indent <*> blockType

357blockHeaderStart = try $ (,) <$> indent <*> blockType

@@ -365,10 +359,10 @@ blockHeaderStart = try $ (,) <$> indent <*> blockType

365 indent = length <$> many spaceChar

359 indent = length <$> many spaceChar

366 blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)

360 blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)

367

361

368−withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)

362+withRaw' :: (String -> Blocks) -> BlockProperties -> OrgParser Blocks

369withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))

363withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))

370

364

371−withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)

365+withParsed :: (Blocks -> Blocks) -> BlockProperties -> OrgParser Blocks

372withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))

366withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))

373

367

374ignHeaders :: OrgParser ()

368ignHeaders :: OrgParser ()

@@ -377,11 +371,11 @@ ignHeaders = (() <$ newline) <|> (() <$ anyLine)

377divWithClass :: String -> Blocks -> Blocks

371divWithClass :: String -> Blocks -> Blocks

378divWithClass cls = B.divWith ("", [cls], [])

372divWithClass cls = B.divWith ("", [cls], [])

379

373

380−verseBlock :: BlockProperties -> OrgParser (F Blocks)

374+verseBlock :: BlockProperties -> OrgParser Blocks

381verseBlock blkProp = try $ do

375verseBlock blkProp = try $ do

382 ignHeaders

376 ignHeaders

383 content <- rawBlockContent blkProp

377 content <- rawBlockContent blkProp

384− fmap B.para . mconcat . intersperse (pure B.linebreak)

378+ B.para . mconcat . intersperse B.linebreak

385 <$> mapM (parseFromString parseInlines) (lines content)

379 <$> mapM (parseFromString parseInlines) (lines content)

386

380

387exportsCode :: [(String, String)] -> Bool

381exportsCode :: [(String, String)] -> Bool

@@ -398,7 +392,7 @@ followingResultsBlock =

398 *> blankline

392 *> blankline

399 *> (unlines <$> many1 exampleLine))

393 *> (unlines <$> many1 exampleLine))

400

394

401−codeBlock :: BlockProperties -> OrgParser (F Blocks)

395+codeBlock :: BlockProperties -> OrgParser Blocks

402codeBlock blkProp = do

396codeBlock blkProp = do

403 skipSpaces

397 skipSpaces

404 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)

398 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)

@@ -408,17 +402,15 @@ codeBlock blkProp = do

408 let includeCode = exportsCode kv

402 let includeCode = exportsCode kv

409 let includeResults = exportsResults kv

403 let includeResults = exportsResults kv

410 let codeBlck = B.codeBlockWith ( id', classes, kv ) content

404 let codeBlck = B.codeBlockWith ( id', classes, kv ) content

411− labelledBlck <- maybe (pure codeBlck)

405+ labelledBlck <- maybe codeBlck (labelDiv codeBlck)

412− (labelDiv codeBlck)

413 <$> lookupInlinesAttr "caption"

406 <$> lookupInlinesAttr "caption"

414− let resultBlck = pure $ maybe mempty (exampleCode) resultsContent

407+ let resultBlck = maybe mempty exampleCode resultsContent

415 return $ (if includeCode then labelledBlck else mempty)

408 return $ (if includeCode then labelledBlck else mempty)

416 <> (if includeResults then resultBlck else mempty)

409 <> (if includeResults then resultBlck else mempty)

417 where

410 where

418 labelDiv blk value =

411 labelDiv blk value =

419− B.divWith nullAttr <$> (mappend <$> labelledBlock value

412+ B.divWith nullAttr (labelledBlock value <> blk)

420− <*> pure blk)

421− labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))

413+ labelledBlock = B.plain . B.spanWith ("", ["label"], [])

422

414

423rawBlockContent :: BlockProperties -> OrgParser String

415rawBlockContent :: BlockProperties -> OrgParser String

424rawBlockContent (indent, blockType) = try $

416rawBlockContent (indent, blockType) = try $

@@ -427,7 +419,7 @@ rawBlockContent (indent, blockType) = try $

427 indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)

419 indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)

428 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)

420 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)

429

421

430−parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)

422+parsedBlockContent :: BlockProperties -> OrgParser Blocks

431parsedBlockContent blkProps = try $ do

423parsedBlockContent blkProps = try $ do

432 raw <- rawBlockContent blkProps

424 raw <- rawBlockContent blkProps

433 parseFromString parseBlocks (raw ++ "\n")

425 parseFromString parseBlocks (raw ++ "\n")

@@ -518,9 +510,9 @@ commaEscaped (',':cs@('*':_)) = cs

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

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

519commaEscaped cs = cs

511commaEscaped cs = cs

520

512

521−example :: OrgParser (F Blocks)

513+example :: OrgParser Blocks

522example = try $ do

514example = try $ do

523− return . return . exampleCode =<< unlines <$> many1 exampleLine

515+ return . exampleCode =<< unlines <$> many1 exampleLine

524

516

525exampleCode :: String -> Blocks

517exampleCode :: String -> Blocks

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

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

@@ -529,7 +521,7 @@ exampleLine :: OrgParser String

529exampleLine = try $ skipSpaces *> string ": " *> anyLine

521exampleLine = try $ skipSpaces *> string ": " *> anyLine

530

522

531-- Drawers for properties or a logbook

523-- Drawers for properties or a logbook

532−drawer :: OrgParser (F Blocks)

524+drawer :: OrgParser Blocks

533drawer = try $ do

525drawer = try $ do

534 drawerStart

526 drawerStart

535 manyTill drawerLine (try drawerEnd)

527 manyTill drawerLine (try drawerEnd)

@@ -555,14 +547,12 @@ drawerEnd = try $

555--

547--

556

548

557-- Figures (Image on a line by itself, preceded by name and/or caption)

549-- Figures (Image on a line by itself, preceded by name and/or caption)

558−figure :: OrgParser (F Blocks)

550+figure :: OrgParser Blocks

559figure = try $ do

551figure = try $ do

560 (cap, nam) <- nameAndCaption

552 (cap, nam) <- nameAndCaption

561 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline

553 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline

562 guard (isImageFilename src)

554 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

566 where

556 where

567 nameAndCaption =

557 nameAndCaption =

568 do

558 do

@@ -578,8 +568,8 @@ figure = try $ do

578

568

579--

569--

580-- Comments, Options and Metadata

570-- Comments, Options and Metadata

581−specialLine :: OrgParser (F Blocks)

571+specialLine :: OrgParser Blocks

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

572+specialLine = try $ metaLine <|> commentLine

583

573

584metaLine :: OrgParser Blocks

574metaLine :: OrgParser Blocks

585metaLine = try $ mempty

575metaLine = try $ mempty

@@ -599,14 +589,14 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

599declarationLine :: OrgParser ()

589declarationLine :: OrgParser ()

600declarationLine = try $ do

590declarationLine = try $ do

601 key <- metaKey

591 key <- metaKey

602− inlinesF <- metaInlines

592+ inlines <- metaInlines

603 updateState $ \st ->

593 updateState $ \st ->

604− let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta

594+ let meta' = B.setMeta key inlines nullMeta

605− in st { orgStateMeta' = orgStateMeta' st <> meta' }

595+ in st { orgStateMeta = orgStateMeta st <> meta' }

606 return ()

596 return ()

607

597

608−metaInlines :: OrgParser (F MetaValue)

598+metaInlines :: OrgParser MetaValue

609−metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

599+metaInlines = (MetaInlines . B.toList) <$> inlinesTillNewline

610

600

611metaKey :: OrgParser String

601metaKey :: OrgParser String

612metaKey = map toLower <$> many1 (noneOf ": \n\r")

602metaKey = map toLower <$> many1 (noneOf ": \n\r")

@@ -647,11 +637,11 @@ parseFormat = try $ do

647--

637--

648

638

649-- | Headers

639-- | Headers

650−header :: OrgParser (F Blocks)

640+header :: OrgParser Blocks

651header = try $ do

641header = try $ do

652 level <- headerStart

642 level <- headerStart

653 title <- inlinesTillNewline

643 title <- inlinesTillNewline

654− return $ B.header level <$> title

644+ return $ B.header level title

655

645

656headerStart :: OrgParser Int

646headerStart :: OrgParser Int

657headerStart = try $

647headerStart = try $

@@ -675,7 +665,7 @@ hline = try $ do

675-- Tables

665-- Tables

676--

666--

677

667

678−data OrgTableRow = OrgContentRow (F [Blocks])

668+data OrgTableRow = OrgContentRow [Blocks]

679 | OrgAlignRow [Alignment]

669 | OrgAlignRow [Alignment]

680 | OrgHlineRow

670 | OrgHlineRow

681

671

@@ -686,13 +676,13 @@ data OrgTable = OrgTable

686 , orgTableRows :: [[Blocks]]

676 , orgTableRows :: [[Blocks]]

687 }

677 }

688

678

689−table :: OrgParser (F Blocks)

679+table :: OrgParser Blocks

690table = try $ do

680table = try $ do

691 lookAhead tableStart

681 lookAhead tableStart

692 do

682 do

693 rows <- tableRows

683 rows <- tableRows

694− cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"

684+ (cptn :: Inlines) <- fromMaybe "" <$> lookupInlinesAttr "caption"

695− return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows

685+ return $ ($ cptn) . orgToPandocTable . normalizeTable . rowsToTable $ rows

696

686

697orgToPandocTable :: OrgTable

687orgToPandocTable :: OrgTable

698 -> Inlines

688 -> Inlines

@@ -708,11 +698,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

708

698

709tableContentRow :: OrgParser OrgTableRow

699tableContentRow :: OrgParser OrgTableRow

710tableContentRow = try $

700tableContentRow = try $

711− OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)

701+ OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)

712

702

713−tableContentCell :: OrgParser (F Blocks)

703+tableContentCell :: OrgParser Blocks

714tableContentCell = try $

704tableContentCell = try $

715− fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell

705+ B.plain . trimInlines . mconcat <$> many1Till inline endOfCell

716

706

717endOfCell :: OrgParser Char

707endOfCell :: OrgParser Char

718endOfCell = try $ char '|' <|> lookAhead newline

708endOfCell = try $ char '|' <|> lookAhead newline

@@ -744,8 +734,8 @@ tableHline = try $

744 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)

734 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)

745

735

746rowsToTable :: [OrgTableRow]

736rowsToTable :: [OrgTableRow]

747− -> F OrgTable

737+ -> OrgTable

748−rowsToTable = foldM (flip rowToContent) zeroTable

738+rowsToTable = foldl' (flip rowToContent) zeroTable

749 where zeroTable = OrgTable 0 mempty mempty mempty

739 where zeroTable = OrgTable 0 mempty mempty mempty

750

740

751normalizeTable :: OrgTable

741normalizeTable :: OrgTable

@@ -764,45 +754,43 @@ normalizeTable (OrgTable cols aligns heads lns) =

764-- line as a header. All other horizontal lines are discarded.

754-- line as a header. All other horizontal lines are discarded.

765rowToContent :: OrgTableRow

755rowToContent :: OrgTableRow

766 -> OrgTable

756 -> OrgTable

767− -> F OrgTable

757+ -> OrgTable

768rowToContent OrgHlineRow t = maybeBodyToHeader t

758rowToContent OrgHlineRow t = maybeBodyToHeader t

769−rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t

759+rowToContent (OrgAlignRow as) t = setLongestRow as . setAligns as $ t

770−rowToContent (OrgContentRow rf) t = do

760+rowToContent (OrgContentRow rf) t = setLongestRow rf . appendToBody rf $ t

771− rs <- rf

772− setLongestRow rs =<< appendToBody rs t

773

761

774setLongestRow :: [a]

762setLongestRow :: [a]

775 -> OrgTable

763 -> OrgTable

776− -> F OrgTable

764+ -> OrgTable

777setLongestRow rs t =

765setLongestRow rs t =

778− return t{ orgTableColumns = max (length rs) (orgTableColumns t) }

766+ t{ orgTableColumns = max (length rs) (orgTableColumns t) }

779

767

780maybeBodyToHeader :: OrgTable

768maybeBodyToHeader :: OrgTable

781− -> F OrgTable

769+ -> OrgTable

782maybeBodyToHeader t = case t of

770maybeBodyToHeader t = case t of

783 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->

771 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->

784− return t{ orgTableHeader = b , orgTableRows = [] }

772+ t{ orgTableHeader = b , orgTableRows = [] }

785− _ -> return t

773+ _ -> t

786

774

787appendToBody :: [Blocks]

775appendToBody :: [Blocks]

788 -> OrgTable

776 -> OrgTable

789− -> F OrgTable

777+ -> OrgTable

790−appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }

778+appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }

791

779

792setAligns :: [Alignment]

780setAligns :: [Alignment]

793 -> OrgTable

781 -> OrgTable

794− -> F OrgTable

782+ -> OrgTable

795−setAligns aligns t = return $ t{ orgTableAlignments = aligns }

783+setAligns aligns t = t{ orgTableAlignments = aligns }

796

784

797

785

798--

786--

799-- LaTeX fragments

787-- LaTeX fragments

800--

788--

801−latexFragment :: OrgParser (F Blocks)

789+latexFragment :: OrgParser Blocks

802latexFragment = try $ do

790latexFragment = try $ do

803 envName <- latexEnvStart

791 envName <- latexEnvStart

804 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)

792 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)

805− return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)

793+ return $ B.rawBlock "latex" (content `inLatexEnv` envName)

806 where

794 where

807 c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"

795 c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"

808 , c

796 , c

@@ -832,7 +820,7 @@ latexEnvName = try $ do

832--

820--

833-- Footnote defintions

821-- Footnote defintions

834--

822--

835−noteBlock :: OrgParser (F Blocks)

823+noteBlock :: OrgParser Blocks

836noteBlock = try $ do

824noteBlock = try $ do

837 ref <- noteMarker <* skipSpaces

825 ref <- noteMarker <* skipSpaces

838 content <- mconcat <$> blocksTillHeaderOrNote

826 content <- mconcat <$> blocksTillHeaderOrNote

@@ -844,37 +832,37 @@ noteBlock = try $ do

844 <|> () <$ lookAhead headerStart)

832 <|> () <$ lookAhead headerStart)

845

833

846-- Paragraphs or Plain text

834-- Paragraphs or Plain text

847−paraOrPlain :: OrgParser (F Blocks)

835+paraOrPlain :: OrgParser Blocks

848paraOrPlain = try $ do

836paraOrPlain = try $ do

849 ils <- parseInlines

837 ils <- parseInlines

850 nl <- option False (newline >> return True)

838 nl <- option False (newline >> return True)

851 try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>

839 try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>

852− return (B.para <$> ils))

840+ (return $ B.para ils))

853− <|> (return (B.plain <$> ils))

841+ <|> (return $ B.plain ils)

854

842

855−inlinesTillNewline :: OrgParser (F Inlines)

843+inlinesTillNewline :: OrgParser Inlines

856−inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline

844+inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline

857

845

858

846

859--

847--

860-- list blocks

848-- list blocks

861--

849--

862

850

863−list :: OrgParser (F Blocks)

851+list :: OrgParser Blocks

864list = choice [ definitionList, bulletList, orderedList ] <?> "list"

852list = choice [ definitionList, bulletList, orderedList ] <?> "list"

865

853

866−definitionList :: OrgParser (F Blocks)

854+definitionList :: OrgParser Blocks

867definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)

855definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)

868− fmap B.definitionList . fmap compactify'DL . sequence

856+ B.definitionList . compactify'DL

869 <$> many1 (definitionListItem $ bulletListStart' (Just n))

857 <$> many1 (definitionListItem $ bulletListStart' (Just n))

870

858

871−bulletList :: OrgParser (F Blocks)

859+bulletList :: OrgParser Blocks

872bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)

860bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)

873− fmap B.bulletList . fmap compactify' . sequence

861+ B.bulletList . compactify'

874 <$> many1 (listItem (bulletListStart' $ Just n))

862 <$> many1 (listItem (bulletListStart' $ Just n))

875

863

876−orderedList :: OrgParser (F Blocks)

864+orderedList :: OrgParser Blocks

877−orderedList = fmap B.orderedList . fmap compactify' . sequence

865+orderedList = B.orderedList . compactify'

878 <$> many1 (listItem orderedListStart)

866 <$> many1 (listItem orderedListStart)

879

867

880genericListStart :: OrgParser String

868genericListStart :: OrgParser String

@@ -911,7 +899,7 @@ orderedListStart = genericListStart orderedListMarker

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

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

912

900

913definitionListItem :: OrgParser Int

901definitionListItem :: OrgParser Int

914− -> OrgParser (F (Inlines, [Blocks]))

902+ -> OrgParser (Inlines, [Blocks])

915definitionListItem parseMarkerGetLength = try $ do

903definitionListItem parseMarkerGetLength = try $ do

916 markerLength <- parseMarkerGetLength

904 markerLength <- parseMarkerGetLength

917 term <- manyTill (noneOf "\n\r") (try $ string "::")

905 term <- manyTill (noneOf "\n\r") (try $ string "::")

@@ -920,12 +908,12 @@ definitionListItem parseMarkerGetLength = try $ do

920 cont <- concat <$> many (listContinuation markerLength)

908 cont <- concat <$> many (listContinuation markerLength)

921 term' <- parseFromString parseInlines term

909 term' <- parseFromString parseInlines term

922 contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont

910 contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont

923− return $ (,) <$> term' <*> fmap (:[]) contents'

911+ return (term', [contents'])

924

912

925

913

926-- parse raw text for one list item, excluding start marker and continuations

914-- parse raw text for one list item, excluding start marker and continuations

927listItem :: OrgParser Int

915listItem :: OrgParser Int

928− -> OrgParser (F Blocks)

916+ -> OrgParser Blocks

929listItem start = try $ do

917listItem start = try $ do

930 markerLength <- try start

918 markerLength <- try start

931 firstLine <- anyLineNewline

919 firstLine <- anyLineNewline

@@ -951,7 +939,7 @@ anyLineNewline = (++ "\n") <$> anyLine

951-- inline

939-- inline

952--

940--

953

941

954−inline :: OrgParser (F Inlines)

942+inline :: OrgParser Inlines

955inline =

943inline =

956 choice [ whitespace

944 choice [ whitespace

957 , linebreak

945 , linebreak

@@ -978,31 +966,31 @@ inline =

978 ] <* (guard =<< newlinesCountWithinLimits)

966 ] <* (guard =<< newlinesCountWithinLimits)

979 <?> "inline"

967 <?> "inline"

980

968

981−parseInlines :: OrgParser (F Inlines)

969+parseInlines :: OrgParser Inlines

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

970+parseInlines = trimInlines . mconcat <$> many1 inline

983

971

984-- treat these as potentially non-text when parsing inline:

972-- treat these as potentially non-text when parsing inline:

985specialChars :: [Char]

973specialChars :: [Char]

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

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

987

975

988

976

989−whitespace :: OrgParser (F Inlines)

977+whitespace :: OrgParser Inlines

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

978+whitespace = B.space <$ skipMany1 spaceChar

991 <* updateLastPreCharPos

979 <* updateLastPreCharPos

992 <* updateLastForbiddenCharPos

980 <* updateLastForbiddenCharPos

993 <?> "whitespace"

981 <?> "whitespace"

994

982

995−linebreak :: OrgParser (F Inlines)

983+linebreak :: OrgParser Inlines

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

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

997

985

998−str :: OrgParser (F Inlines)

986+str :: OrgParser Inlines

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

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

1000 <* updateLastStrPos

988 <* updateLastStrPos

1001

989

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

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

1003-- break. This should reflect the values of the Emacs variable

991-- break. This should reflect the values of the Emacs variable

1004-- @org-element-pagaraph-separate@.

992-- @org-element-pagaraph-separate@.

1005−endline :: OrgParser (F Inlines)

993+endline :: OrgParser Inlines

1006endline = try $ do

994endline = try $ do

1007 newline

995 newline

1008 notFollowedBy blankline

996 notFollowedBy blankline

@@ -1020,77 +1008,72 @@ endline = try $ do

1020 decEmphasisNewlinesCount

1008 decEmphasisNewlinesCount

1021 guard =<< newlinesCountWithinLimits

1009 guard =<< newlinesCountWithinLimits

1022 updateLastPreCharPos

1010 updateLastPreCharPos

1023− return . return $ B.space

1011+ return $ B.space

1024

1012

1025−cite :: OrgParser (F Inlines)

1013+cite :: OrgParser Inlines

1026cite = try $ do

1014cite = try $ do

1027 guardEnabled Ext_citations

1015 guardEnabled Ext_citations

1028 (cs, raw) <- withRaw normalCite

1016 (cs, raw) <- withRaw normalCite

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

1017+ return $ flip B.cite (B.text raw) cs

1030

1018

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

1019+normalCite :: OrgParser [Citation]

1032normalCite = try $ char '['

1020normalCite = try $ char '['

1033 *> skipSpaces

1021 *> skipSpaces

1034 *> citeList

1022 *> citeList

1035 <* skipSpaces

1023 <* skipSpaces

1036 <* char ']'

1024 <* char ']'

1037

1025

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

1026+citeList :: OrgParser [Citation]

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

1027+citeList = sepBy1 citation (try $ char ';' *> skipSpaces)

1040

1028

1041−citation :: OrgParser (F Citation)

1029+citation :: OrgParser Citation

1042citation = try $ do

1030citation = try $ do

1043 pref <- prefix

1031 pref <- prefix

1044 (suppress_author, key) <- citeKey

1032 (suppress_author, key) <- citeKey

1045 suff <- suffix

1033 suff <- suffix

1046− return $ do

1047− x <- pref

1048− y <- suff

1049− return $ Citation{ citationId = key

1034+ return $ Citation{ citationId = key

1050− , citationPrefix = B.toList x

1035+ , citationPrefix = B.toList pref

1051− , citationSuffix = B.toList y

1036+ , citationSuffix = B.toList suff

1052− , citationMode = if suppress_author

1037+ , citationMode = if suppress_author

1053− then SuppressAuthor

1038+ then SuppressAuthor

1054− else NormalCitation

1039+ else NormalCitation

1055− , citationNoteNum = 0

1040+ , citationNoteNum = 0

1056− , citationHash = 0

1041+ , citationHash = 0

1057− }

1042+ }

1058 where

1043 where

1059− prefix = trimInlinesF . mconcat <$>

1044+ prefix = trimInlines . mconcat <$>

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

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

1061 suffix = try $ do

1046 suffix = try $ do

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

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

1063 skipSpaces

1048 skipSpaces

1064− rest <- trimInlinesF . mconcat <$>

1049+ rest <- trimInlines . mconcat <$>

1065 many (notFollowedBy (oneOf ";]") *> inline)

1050 many (notFollowedBy (oneOf ";]") *> inline)

1051+ return $

1066− return $ if hasSpace

1052+ if hasSpace

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

1053+ then B.space <> rest

1068− else rest

1054+ else rest

1069

1055

1070−footnote :: OrgParser (F Inlines)

1056+footnote :: OrgParser Inlines

1071footnote = try $ inlineNote <|> referencedNote

1057footnote = try $ inlineNote <|> referencedNote

1072

1058

1073−inlineNote :: OrgParser (F Inlines)

1059+inlineNote :: OrgParser Inlines

1074inlineNote = try $ do

1060inlineNote = try $ do

1075 string "[fn:"

1061 string "[fn:"

1076 ref <- many alphaNum

1062 ref <- many alphaNum

1077 char ':'

1063 char ':'

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

1064+ note <- B.para . trimInlines . mconcat <$> many1Till inline (char ']')

1079 when (not $ null ref) $

1065 when (not $ null ref) $

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

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

1081− return $ B.note <$> note

1067+ return $ B.note note

1082

1068

1083−referencedNote :: OrgParser (F Inlines)

1069+referencedNote :: OrgParser Inlines

1084referencedNote = try $ do

1070referencedNote = try $ do

1085 ref <- noteMarker

1071 ref <- noteMarker

1086− return $ do

1087− notes <- asksF orgStateNotes'

1072+ notes <- asks (orgStateNotes' . finalState)

1073+ return $

1088 case lookup ref notes of

1074 case lookup ref notes of

1075+ Just contents -> B.note contents

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

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

1090− Just contents -> do

1091− st <- askF

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

1093− return $ B.note contents'

1094

1077

1095noteMarker :: OrgParser String

1078noteMarker :: OrgParser String

1096noteMarker = try $ do

1079noteMarker = try $ do

@@ -1100,37 +1083,37 @@ noteMarker = try $ do

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

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

1101 ]

1084 ]

1102

1085

1103−linkOrImage :: OrgParser (F Inlines)

1086+linkOrImage :: OrgParser Inlines

1104linkOrImage = explicitOrImageLink

1087linkOrImage = explicitOrImageLink

1105 <|> selflinkOrImage

1088 <|> selflinkOrImage

1106 <|> angleLink

1089 <|> angleLink

1107 <|> plainLink

1090 <|> plainLink

1108 <?> "link or image"

1091 <?> "link or image"

1109

1092

1110−explicitOrImageLink :: OrgParser (F Inlines)

1093+explicitOrImageLink :: OrgParser Inlines

1111explicitOrImageLink = try $ do

1094explicitOrImageLink = try $ do

1112 char '['

1095 char '['

1113− srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

1096+ src <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

1114 title <- enclosedRaw (char '[') (char ']')

1097 title <- enclosedRaw (char '[') (char ']')

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

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

1116 char ']'

1099 char ']'

1117− return $ do

1100+ alt <- internalLink src title'

1118− src <- srcF

1101+ return $

1119− if isImageFilename src && isImageFilename title

1102+ (if isImageFilename src && isImageFilename title

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

1103+ then B.link src "" $ B.image title mempty mempty

1121− else linkToInlinesF src =<< title'

1104+ else fromMaybe alt (linkToInlines src title'))

1122

1105

1123−selflinkOrImage :: OrgParser (F Inlines)

1106+selflinkOrImage :: OrgParser Inlines

1124selflinkOrImage = try $ do

1107selflinkOrImage = try $ do

1125 src <- char '[' *> linkTarget <* char ']'

1108 src <- char '[' *> linkTarget <* char ']'

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

1109+ return $ fromMaybe "" (linkToInlines src (B.str src))

1127

1110

1128−plainLink :: OrgParser (F Inlines)

1111+plainLink :: OrgParser Inlines

1129plainLink = try $ do

1112plainLink = try $ do

1130 (orig, src) <- uri

1113 (orig, src) <- uri

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

1114+ return $ B.link src "" (B.str orig)

1132

1115

1133−angleLink :: OrgParser (F Inlines)

1116+angleLink :: OrgParser Inlines

1134angleLink = try $ do

1117angleLink = try $ do

1135 char '<'

1118 char '<'

1136 link <- plainLink

1119 link <- plainLink

@@ -1146,26 +1129,31 @@ linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

1146possiblyEmptyLinkTarget :: OrgParser String

1129possiblyEmptyLinkTarget :: OrgParser String

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

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

1148

1131

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

1132+applyCustomLinkFormat :: String -> OrgParser String

1150applyCustomLinkFormat link = do

1133applyCustomLinkFormat link = do

1151 let (linkType, rest) = break (== ':') link

1134 let (linkType, rest) = break (== ':') link

1152− return $ do

1135+ fmts <- asks finalState

1136+ return $

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

1137+ case M.lookup linkType (orgStateLinkFormatters fmts) of

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

1138+ Just v -> (v (drop 1 rest))

1139+ Nothing -> link

1155

1140

1156-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind

1141-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind

1157-- of parsing.

1142-- of parsing.

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

1143+linkToInlines :: String -> Inlines -> Maybe Inlines

1159−linkToInlinesF s =

1144+linkToInlines = \s ->

1160 case s of

1145 case s of

1161− "" -> pure . B.link "" ""

1146+ _ | null s -> Just . B.link "" ""

1162− ('#':_) -> pure . B.link s ""

1147+ _ | isAnchor s -> Just . B.link s ""

1163− _ | isImageFilename s -> const . pure $ B.image s "" ""

1148+ _ | isImageFilename s -> const . Just $ B.image s "" ""

1164− _ | isFileLink s -> pure . B.link (dropLinkType s) ""

1149+ _ | isFileLink s -> Just . B.link (dropLinkType s) ""

1165− _ | isUri s -> pure . B.link s ""

1150+ _ | isUri s -> Just . B.link s ""

1166− _ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""

1151+ _ | isAbsoluteFilePath s -> Just . B.link ("file://" ++ s) ""

1167− _ | isRelativeFilePath s -> pure . B.link s ""

1152+ _ | isRelativeFilePath s -> Just . B.link s ""

1168− _ -> internalLink s

1153+ _ -> const Nothing

1154+

1155+isAnchor :: String -> Bool

1156+isAnchor s = "#" `isPrefixOf` s

1169

1157

1170isFileLink :: String -> Bool

1158isFileLink :: String -> Bool

1171isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)

1159isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)

@@ -1194,12 +1182,13 @@ isImageFilename filename =

1194 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

1182 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

1195 protocols = [ "file", "http", "https" ]

1183 protocols = [ "file", "http", "https" ]

1196

1184

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

1185+internalLink :: String -> Inlines -> OrgParser Inlines

1198internalLink link title = do

1186internalLink link title = do

1187+ anchorB <- asks finalState

1188+ return $

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

1189+ if link `elem` (orgStateAnchorIds anchorB)

1200− if anchorB

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

1190+ then B.link ('#':link) "" title

1202− else return $ B.emph title

1191+ else B.emph title

1203

1192

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

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

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

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

@@ -1207,11 +1196,11 @@ internalLink link title = do

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

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

1208-- an anchor.

1197-- an anchor.

1209

1198

1210−anchor :: OrgParser (F Inlines)

1199+anchor :: OrgParser Inlines

1211anchor = try $ do

1200anchor = try $ do

1212 anchorId <- parseAnchor

1201 anchorId <- parseAnchor

1213 recordAnchorId anchorId

1202 recordAnchorId anchorId

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

1203+ return $ B.spanWith (solidify anchorId, [], []) mempty

1215 where

1204 where

1216 parseAnchor = string "<<"

1205 parseAnchor = string "<<"

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

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

@@ -1229,7 +1218,7 @@ solidify = map replaceSpecialChar

1229 | otherwise = '-'

1218 | otherwise = '-'

1230

1219

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

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

1232−inlineCodeBlock :: OrgParser (F Inlines)

1221+inlineCodeBlock :: OrgParser Inlines

1233inlineCodeBlock = try $ do

1222inlineCodeBlock = try $ do

1234 string "src_"

1223 string "src_"

1235 lang <- many1 orgArgWordChar

1224 lang <- many1 orgArgWordChar

@@ -1237,7 +1226,7 @@ inlineCodeBlock = try $ do

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

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

1238 let attrClasses = [translateLang lang, rundocBlockClass]

1227 let attrClasses = [translateLang lang, rundocBlockClass]

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

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

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

1229+ return $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1241

1230

1242enclosedByPair :: Char -- ^ opening char

1231enclosedByPair :: Char -- ^ opening char

1243 -> Char -- ^ closing char

1232 -> Char -- ^ closing char

@@ -1245,41 +1234,40 @@ enclosedByPair :: Char -- ^ opening char

1245 -> OrgParser [a]

1234 -> OrgParser [a]

1246enclosedByPair s e p = char s *> many1Till p (char e)

1235enclosedByPair s e p = char s *> many1Till p (char e)

1247

1236

1248−emph :: OrgParser (F Inlines)

1237+emph :: OrgParser Inlines

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

1238+emph = B.emph <$> emphasisBetween '/'

1250

1239

1251−strong :: OrgParser (F Inlines)

1240+strong :: OrgParser Inlines

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

1241+strong = B.strong <$> emphasisBetween '*'

1253

1242

1254−strikeout :: OrgParser (F Inlines)

1243+strikeout :: OrgParser Inlines

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

1244+strikeout = B.strikeout <$> emphasisBetween '+'

1256

1245

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

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

1258−underline :: OrgParser (F Inlines)

1247+underline :: OrgParser Inlines

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

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

1260

1249

1261−verbatim :: OrgParser (F Inlines)

1250+verbatim :: OrgParser Inlines

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

1251+verbatim = B.code <$> verbatimBetween '='

1263

1252

1264−code :: OrgParser (F Inlines)

1253+code :: OrgParser Inlines

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

1254+code = B.code <$> verbatimBetween '~'

1266

1255

1267−subscript :: OrgParser (F Inlines)

1256+subscript :: OrgParser Inlines

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

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

1269

1258

1270−superscript :: OrgParser (F Inlines)

1259+superscript :: OrgParser Inlines

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

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

1272

1261

1273−math :: OrgParser (F Inlines)

1262+math :: OrgParser Inlines

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

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

1275 , mathStringBetween '$'

1264 , mathStringBetween '$'

1276 , rawMathBetween "\$" "\$"

1265 , rawMathBetween "\$" "\$"

1277 ]

1266 ]

1278

1267

1279−displayMath :: OrgParser (F Inlines)

1268+displayMath :: OrgParser Inlines

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

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

1281− , rawMathBetween "$$" "$$"

1270+ , rawMathBetween "$$" "$$" ]

1282− ]

1283

1271

1284updatePositions :: Char

1272updatePositions :: Char

1285 -> OrgParser (Char)

1273 -> OrgParser (Char)

@@ -1288,11 +1276,11 @@ updatePositions c = do

1288 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1276 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1289 return c

1277 return c

1290

1278

1291−symbol :: OrgParser (F Inlines)

1279+symbol :: OrgParser Inlines

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

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

1293

1281

1294emphasisBetween :: Char

1282emphasisBetween :: Char

1295− -> OrgParser (F Inlines)

1283+ -> OrgParser Inlines

1296emphasisBetween c = try $ do

1284emphasisBetween c = try $ do

1297 startEmphasisNewlinesCounting emphasisAllowedNewlines

1285 startEmphasisNewlinesCounting emphasisAllowedNewlines

1298 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

1286 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

@@ -1369,9 +1357,9 @@ mathEnd c = try $ do

1369

1357

1370enclosedInlines :: OrgParser a

1358enclosedInlines :: OrgParser a

1371 -> OrgParser b

1359 -> OrgParser b

1372− -> OrgParser (F Inlines)

1360+ -> OrgParser Inlines

1373enclosedInlines start end = try $

1361enclosedInlines start end = try $

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

1362+ trimInlines . mconcat <$> enclosed start end inline

1375

1363

1376enclosedRaw :: OrgParser a

1364enclosedRaw :: OrgParser a

1377 -> OrgParser b

1365 -> OrgParser b

@@ -1450,7 +1438,7 @@ notAfterForbiddenBorderChar = do

1450 return $ lastFBCPos /= Just pos

1438 return $ lastFBCPos /= Just pos

1451

1439

1452-- | Read a sub- or superscript expression

1440-- | Read a sub- or superscript expression

1453−subOrSuperExpr :: OrgParser (F Inlines)

1441+subOrSuperExpr :: OrgParser Inlines

1454subOrSuperExpr = try $

1442subOrSuperExpr = try $

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

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

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

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

@@ -1465,10 +1453,10 @@ simpleSubOrSuperString = try $

1465 <*> many1 alphaNum

1453 <*> many1 alphaNum

1466 ]

1454 ]

1467

1455

1468−inlineLaTeX :: OrgParser (F Inlines)

1456+inlineLaTeX :: OrgParser Inlines

1469inlineLaTeX = try $ do

1457inlineLaTeX = try $ do

1470 cmd <- inlineLaTeXCommand

1458 cmd <- inlineLaTeXCommand

1471− maybe mzero returnF $

1459+ maybe mzero return $

1472 parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

1460 parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

1473 where

1461 where

1474 parseAsMath :: String -> Maybe Inlines

1462 parseAsMath :: String -> Maybe Inlines

@@ -1501,30 +1489,30 @@ inlineLaTeXCommand = try $ do

1501 return cs

1489 return cs

1502 _ -> mzero

1490 _ -> mzero

1503

1491

1504−smart :: OrgParser (F Inlines)

1492+smart :: OrgParser Inlines

1505smart = do

1493smart = do

1506 getOption readerSmart >>= guard

1494 getOption readerSmart >>= guard

1507 doubleQuoted <|> singleQuoted <|>

1495 doubleQuoted <|> singleQuoted <|>

1508− choice (map (return <$>) [orgApostrophe, dash, ellipses])

1496+ choice [orgApostrophe, dash, ellipses]

1509 where orgApostrophe =

1497 where orgApostrophe =

1510 (char '\'' <|> char '\8217') <* updateLastPreCharPos

1498 (char '\'' <|> char '\8217') <* updateLastPreCharPos

1511 <* updateLastForbiddenCharPos

1499 <* updateLastForbiddenCharPos

1512 *> return (B.str "\x2019")

1500 *> return (B.str "\x2019")

1513

1501

1514−singleQuoted :: OrgParser (F Inlines)

1502+singleQuoted :: OrgParser Inlines

1515singleQuoted = try $ do

1503singleQuoted = try $ do

1516 singleQuoteStart

1504 singleQuoteStart

1517 withQuoteContext InSingleQuote $

1505 withQuoteContext InSingleQuote $

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

1506+ B.singleQuoted . trimInlines . mconcat <$>

1519 many1Till inline singleQuoteEnd

1507 many1Till inline singleQuoteEnd

1520

1508

1521-- doubleQuoted will handle regular double-quoted sections, as well

1509-- doubleQuoted will handle regular double-quoted sections, as well

1522-- as dialogues with an open double-quote without a close double-quote

1510-- as dialogues with an open double-quote without a close double-quote

1523-- in the same paragraph.

1511-- in the same paragraph.

1524−doubleQuoted :: OrgParser (F Inlines)

1512+doubleQuoted :: OrgParser Inlines

1525doubleQuoted = try $ do

1513doubleQuoted = try $ do

1526 doubleQuoteStart

1514 doubleQuoteStart

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

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

1528 (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

1516 (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

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

1517+ (B.doubleQuoted . trimInlines $ contents))

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

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