92582c6 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: introduce Reader environment around Blocks/Inlines

92582c6Albert Krewinkel13 years ago

src/Text/Pandoc/Readers/Org.hs+176−130

compare with master

unifiedsplit

@@ -1,4 +1,5 @@

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-

3{-

@@ -29,21 +30,26 @@ Conversion of org-mode formatted plain text to 'Pandoc' document.

29module Text.Pandoc.Readers.Org ( readOrg ) where

30module Text.Pandoc.Readers.Org ( readOrg ) where

31import qualified Text.Pandoc.Builder as B

32import 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 )

33import Text.Pandoc.Definition

35import Text.Pandoc.Definition

34import Text.Pandoc.Options

36import Text.Pandoc.Options

35import qualified Text.Pandoc.Parsing as P

37import qualified Text.Pandoc.Parsing as P

38+import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF

36−import Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos)

39+ , newline, orderedListMarker

40+ , updateLastStrPos )

37import Text.Pandoc.Shared (compactify')

41import Text.Pandoc.Shared (compactify')

39−import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))

43+import Control.Applicative ( Applicative, pure

44+ , (<$>), (<$), (<*>), (<*), (*>), (<**>) )

40import Control.Arrow ((***))

45import Control.Arrow ((***))

41−import Control.Monad (guard, when)

46+import Control.Monad (foldM, guard, liftM, liftM2, when)

47+import Control.Monad.Reader (Reader, runReader)

42import Data.Char (toLower)

48import Data.Char (toLower)

43import Data.Default

49import Data.Default

44−import Data.List (foldl', isPrefixOf, isSuffixOf)

50+import Data.List (isPrefixOf, isSuffixOf)

45import Data.Maybe (listToMaybe, fromMaybe)

51import Data.Maybe (listToMaybe, fromMaybe)

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

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

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

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

49readOrg :: ReaderOptions -- ^ Reader options

55readOrg :: ReaderOptions -- ^ Reader options

@@ -55,10 +61,10 @@ type OrgParser = Parser [Char] OrgParserState

56parseOrg:: OrgParser Pandoc

62parseOrg:: OrgParser Pandoc

57parseOrg = do

63parseOrg = do

58− blocks' <- B.toList <$> parseBlocks

64+ blocks' <- parseBlocks

59 st <- getState

65 st <- getState

60− let meta = orgStateMeta st

66+ let meta = runF (orgStateMeta' st) st

61− return $ Pandoc meta $ filter (/= Null) blocks'

67+ return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st)

63--

69--

64-- Parser State for Org

70-- Parser State for Org

@@ -73,7 +79,8 @@ data OrgParserState = OrgParserState

73 , orgStateLastPreCharPos :: Maybe SourcePos

79 , orgStateLastPreCharPos :: Maybe SourcePos

74 , orgStateLastStrPos :: Maybe SourcePos

80 , orgStateLastStrPos :: Maybe SourcePos

75 , orgStateMeta :: Meta

81 , orgStateMeta :: Meta

76− } deriving (Show)

82+ , orgStateMeta' :: F Meta

83+ }

78instance HasReaderOptions OrgParserState where

85instance HasReaderOptions OrgParserState where

79 extractReaderOptions = orgStateOptions

86 extractReaderOptions = orgStateOptions

@@ -96,6 +103,7 @@ defaultOrgParserState = OrgParserState

96 , orgStateLastPreCharPos = Nothing

103 , orgStateLastPreCharPos = Nothing

97 , orgStateLastStrPos = Nothing

104 , orgStateLastStrPos = Nothing

98 , orgStateMeta = nullMeta

105 , orgStateMeta = nullMeta

106+ , orgStateMeta' = return nullMeta

99 }

107 }

100

108

101updateLastStrPos :: OrgParser ()

109updateLastStrPos :: OrgParser ()

@@ -138,6 +146,27 @@ resetEmphasisNewlines :: OrgParser ()

138resetEmphasisNewlines = updateState $ \s ->

146resetEmphasisNewlines = updateState $ \s ->

139 s{ orgStateEmphasisNewlines = Nothing }

147 s{ orgStateEmphasisNewlines = Nothing }

140

148

149+

150+--

151+-- Adaptions and specializations of parsing utilities

152+--

153+

154+newtype F a = F { unF :: Reader OrgParserState a

155+ } deriving (Monad, Applicative, Functor)

156+

157+runF :: F a -> OrgParserState -> a

158+runF = runReader . unF

159+

160+instance Monoid a => Monoid (F a) where

161+ mempty = return mempty

162+ mappend = liftM2 mappend

163+ mconcat = fmap mconcat . sequence

164+

165+trimInlinesF :: F Inlines -> F Inlines

166+trimInlinesF = liftM trimInlines

167+

168+

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

141newline :: OrgParser Char

170newline :: OrgParser Char

142newline =

171newline =

143 P.newline

172 P.newline

@@ -148,10 +177,10 @@ newline =

148-- parsing blocks

177-- parsing blocks

149--

178--

150

179

151−parseBlocks :: OrgParser Blocks

180+parseBlocks :: OrgParser (F Blocks)

152parseBlocks = mconcat <$> manyTill block eof

181parseBlocks = mconcat <$> manyTill block eof

153

182

154−block :: OrgParser Blocks

183+block :: OrgParser (F Blocks)

155block = choice [ mempty <$ blanklines

184block = choice [ mempty <$ blanklines

156 , orgBlock

185 , orgBlock

157 , example

186 , example

@@ -159,7 +188,7 @@ block = choice [ mempty <$ blanklines

159 , figure

188 , figure

160 , specialLine

189 , specialLine

161 , header

190 , header

162− , hline

191+ , return <$> hline

163 , list

192 , list

164 , table

193 , table

165 , paraOrPlain

194 , paraOrPlain

@@ -169,15 +198,15 @@ block = choice [ mempty <$ blanklines

169-- Org Blocks (#+BEGIN_... / #+END_...)

198-- Org Blocks (#+BEGIN_... / #+END_...)

170--

199--

171

200

172−orgBlock :: OrgParser Blocks

201+orgBlock :: OrgParser (F Blocks)

173orgBlock = try $ do

202orgBlock = try $ do

174 (indent, blockType, args) <- blockHeader

203 (indent, blockType, args) <- blockHeader

175 blockStr <- rawBlockContent indent blockType

204 blockStr <- rawBlockContent indent blockType

176 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]

205 let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]

177 case blockType of

206 case blockType of

178 "comment" -> return mempty

207 "comment" -> return mempty

179− "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr

208+ "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr

180− _ -> B.divWith ("", [blockType], [])

209+ _ -> fmap (B.divWith ("", [blockType], []))

181 <$> parseFromString parseBlocks blockStr

210 <$> parseFromString parseBlocks blockStr

182

211

183blockHeader :: OrgParser (Int, String, [String])

212blockHeader :: OrgParser (Int, String, [String])

@@ -222,15 +251,16 @@ commaEscaped (',':cs@('*':_)) = cs

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

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

223commaEscaped cs = cs

252commaEscaped cs = cs

224

253

225−example :: OrgParser Blocks

254+example :: OrgParser (F Blocks)

226−example = try $

255+example = try $ do

227− B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine

256+ body <- unlines <$> many1 exampleLine

257+ return . return $ B.codeBlockWith ("", ["example"], []) body

228

258

229exampleLine :: OrgParser String

259exampleLine :: OrgParser String

230exampleLine = try $ string ": " *> anyLine

260exampleLine = try $ string ": " *> anyLine

231

261

232-- Drawers for properties or a logbook

262-- Drawers for properties or a logbook

233−drawer :: OrgParser Blocks

263+drawer :: OrgParser (F Blocks)

234drawer = try $ do

264drawer = try $ do

235 drawerStart

265 drawerStart

236 manyTill drawerLine (try drawerEnd)

266 manyTill drawerLine (try drawerEnd)

@@ -256,18 +286,20 @@ drawerEnd = try $

256--

286--

257

287

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

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

259−figure :: OrgParser Blocks

289+figure :: OrgParser (F Blocks)

260figure = try $ do

290figure = try $ do

261 (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)

291 (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty)

262 <$> nameAndOrCaption

292 <$> nameAndOrCaption

263 src <- skipSpaces *> selfTarget <* skipSpaces <* newline

293 src <- skipSpaces *> selfTarget <* skipSpaces <* newline

264 guard (isImageFilename src)

294 guard (isImageFilename src)

295+ return $ do

296+ cap' <- cap

265− return . B.para $ B.image src tit cap

297+ return $ B.para $ B.image src tit cap'

266 where withFigPrefix cs = if "fig:" `isPrefixOf` cs

298 where withFigPrefix cs = if "fig:" `isPrefixOf` cs

267 then cs

299 then cs

268 else "fig:" ++ cs

300 else "fig:" ++ cs

269

301

270−nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines)

302+nameAndOrCaption :: OrgParser (Maybe String, Maybe (F Inlines))

271nameAndOrCaption = try $ nameFirst <|> captionFirst

303nameAndOrCaption = try $ nameFirst <|> captionFirst

272 where

304 where

273 nameFirst = try $ do

305 nameFirst = try $ do

@@ -279,7 +311,7 @@ nameAndOrCaption = try $ nameFirst <|> captionFirst

279 n <- optionMaybe name

311 n <- optionMaybe name

280 return (n, Just c)

312 return (n, Just c)

281

313

282−caption :: OrgParser Inlines

314+caption :: OrgParser (F Inlines)

283caption = try $ annotation "CAPTION" *> inlinesTillNewline

315caption = try $ annotation "CAPTION" *> inlinesTillNewline

284

316

285name :: OrgParser String

317name :: OrgParser String

@@ -289,8 +321,8 @@ annotation :: String -> OrgParser String

289annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'

321annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':'

290

322

291-- Comments, Options and Metadata

323-- Comments, Options and Metadata

292−specialLine :: OrgParser Blocks

324+specialLine :: OrgParser (F Blocks)

293−specialLine = try $ metaLine <|> commentLine

325+specialLine = fmap return . try $ metaLine <|> commentLine

294

326

295metaLine :: OrgParser Blocks

327metaLine :: OrgParser Blocks

296metaLine = try $ metaLineStart *> declarationLine

328metaLine = try $ metaLineStart *> declarationLine

@@ -308,12 +340,15 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

308

340

309declarationLine :: OrgParser Blocks

341declarationLine :: OrgParser Blocks

310declarationLine = try $ do

342declarationLine = try $ do

343+ key <- metaKey

344+ inlinesF <- metaInlines

345+ updateState $ \st ->

311− meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta

346+ let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta

312− updateState $ \st -> st { orgStateMeta = orgStateMeta st <> meta' }

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

313 return mempty

348 return mempty

314

349

315−metaValue :: OrgParser MetaValue

350+metaInlines :: OrgParser (F MetaValue)

316−metaValue = MetaInlines . B.toList <$> inlinesTillNewline

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

317

352

318metaKey :: OrgParser String

353metaKey :: OrgParser String

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

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

@@ -321,16 +356,20 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")

321 <* skipSpaces

356 <* skipSpaces

322

357

323-- | Headers

358-- | Headers

324−header :: OrgParser Blocks

359+header :: OrgParser (F Blocks)

325−header = try $

360+header = try $ do

326− B.header <$> headerStart

361+ level <- headerStart

327− <*> inlinesTillNewline

362+ title <- inlinesTillNewline

363+ return $ B.header level <$> title

328

364

329headerStart :: OrgParser Int

365headerStart :: OrgParser Int

330headerStart = try $

366headerStart = try $

331 (length <$> many1 (char '*')) <* many1 (char ' ')

367 (length <$> many1 (char '*')) <* many1 (char ' ')

332

368

369+-- Don't use (or need) the reader wrapper here, we want hline to be

370+-- @show@able. Otherwise we can't use it with @notFollowedBy'@.

371+

333−-- Horizontal Line (five dashes or more)

372+-- | Horizontal Line (five -- dashes or more)

334hline :: OrgParser Blocks

373hline :: OrgParser Blocks

335hline = try $ do

374hline = try $ do

336 skipSpaces

375 skipSpaces

@@ -344,22 +383,23 @@ hline = try $ do

344-- Tables

383-- Tables

345--

384--

346

385

347−data OrgTableRow = OrgContentRow [Blocks]

386+data OrgTableRow = OrgContentRow (F [Blocks])

348 | OrgAlignRow [Alignment]

387 | OrgAlignRow [Alignment]

349 | OrgHlineRow

388 | OrgHlineRow

350− deriving (Eq, Show)

351

389

352data OrgTable = OrgTable

390data OrgTable = OrgTable

353 { orgTableColumns :: Int

391 { orgTableColumns :: Int

354 , orgTableAlignments :: [Alignment]

392 , orgTableAlignments :: [Alignment]

355 , orgTableHeader :: [Blocks]

393 , orgTableHeader :: [Blocks]

356 , orgTableRows :: [[Blocks]]

394 , orgTableRows :: [[Blocks]]

357− } deriving (Eq, Show)

395+ }

358

396

359−table :: OrgParser Blocks

397+table :: OrgParser (F Blocks)

360table = try $ do

398table = try $ do

361 lookAhead tableStart

399 lookAhead tableStart

400+ do

401+ rows <- tableRows

362− orgToPandocTable . normalizeTable . rowsToTable <$> tableRows

402+ return $ return . orgToPandocTable . normalizeTable =<< rowsToTable rows

363

403

364orgToPandocTable :: OrgTable

404orgToPandocTable :: OrgTable

365 -> Blocks

405 -> Blocks

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

374

414

375tableContentRow :: OrgParser OrgTableRow

415tableContentRow :: OrgParser OrgTableRow

376tableContentRow = try $

416tableContentRow = try $

377− OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)

417+ OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)

378

418

379−tableContentCell :: OrgParser Blocks

419+tableContentCell :: OrgParser (F Blocks)

380tableContentCell = try $

420tableContentCell = try $

381− B.plain . trimInlines . mconcat <$> many1Till inline endOfCell

421+ fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell

382

422

383endOfCell :: OrgParser Char

423endOfCell :: OrgParser Char

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

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

@@ -410,8 +450,8 @@ tableHline = try $

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

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

411

451

412rowsToTable :: [OrgTableRow]

452rowsToTable :: [OrgTableRow]

413− -> OrgTable

453+ -> F OrgTable

414−rowsToTable = foldl' (flip rowToContent) zeroTable

454+rowsToTable = foldM (flip rowToContent) zeroTable

415 where zeroTable = OrgTable 0 mempty mempty mempty

455 where zeroTable = OrgTable 0 mempty mempty mempty

416

456

417normalizeTable :: OrgTable

457normalizeTable :: OrgTable

@@ -430,57 +470,64 @@ normalizeTable (OrgTable cols aligns heads lns) =

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

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

431rowToContent :: OrgTableRow

471rowToContent :: OrgTableRow

432 -> OrgTable

472 -> OrgTable

433− -> OrgTable

473+ -> F OrgTable

434−rowToContent OrgHlineRow = maybeBodyToHeader

474+rowToContent OrgHlineRow t = maybeBodyToHeader t

435−rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs

436−rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as

475+rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t

476+rowToContent (OrgContentRow rf) t = do

477+ rs <- rf

478+ setLongestRow rs =<< appendToBody rs t

437

479

438setLongestRow :: [a]

480setLongestRow :: [a]

439 -> OrgTable

481 -> OrgTable

440− -> OrgTable

482+ -> F OrgTable

483+setLongestRow rs t =

441−setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) }

484+ return t{ orgTableColumns = max (length rs) (orgTableColumns t) }

442

485

443maybeBodyToHeader :: OrgTable

486maybeBodyToHeader :: OrgTable

444− -> OrgTable

487+ -> F OrgTable

445maybeBodyToHeader t = case t of

488maybeBodyToHeader t = case t of

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

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

447− t{ orgTableHeader = b , orgTableRows = [] }

490+ return t{ orgTableHeader = b , orgTableRows = [] }

448− _ -> t

491+ _ -> return t

449

492

450appendToBody :: [Blocks]

493appendToBody :: [Blocks]

451 -> OrgTable

494 -> OrgTable

452− -> OrgTable

495+ -> F OrgTable

453−appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }

496+appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }

454

497

455setAligns :: [Alignment]

498setAligns :: [Alignment]

456 -> OrgTable

499 -> OrgTable

457− -> OrgTable

500+ -> F OrgTable

458−setAligns aligns t = t{ orgTableAlignments = aligns }

501+setAligns aligns t = return $ t{ orgTableAlignments = aligns }

459

502

460-- Paragraphs or Plain text

503-- Paragraphs or Plain text

461−paraOrPlain :: OrgParser Blocks

504+paraOrPlain :: OrgParser (F Blocks)

462paraOrPlain = try $

505paraOrPlain = try $

463− parseInlines <**> option B.plain (try $ newline *> pure B.para)

506+ parseInlines <**> (fmap <$> option B.plain (try $ newline *> pure B.para))

464

507

465−inlinesTillNewline :: OrgParser Inlines

508+inlinesTillNewline :: OrgParser (F Inlines)

466−inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline

509+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline

467

510

468

511

469--

512--

470-- list blocks

513-- list blocks

471--

514--

472

515

473−list :: OrgParser Blocks

516+list :: OrgParser (F Blocks)

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

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

475

518

476−definitionList :: OrgParser Blocks

519+definitionList :: OrgParser (F Blocks)

520+definitionList = fmap B.definitionList . sequence

477−definitionList = B.definitionList <$> many1 (definitionListItem bulletListStart)

521+ <$> many1 (definitionListItem bulletListStart)

478

522

479−bulletList :: OrgParser Blocks

523+bulletList :: OrgParser (F Blocks)

524+bulletList = fmap B.bulletList . fmap compactify' . sequence

480−bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)

525+ <$> many1 (listItem bulletListStart)

481

526

482−orderedList :: OrgParser Blocks

527+orderedList :: OrgParser (F Blocks)

483−orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)

528+-- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)

529+orderedList = fmap B.orderedList . fmap compactify' . sequence

530+ <$> many1 (listItem orderedListStart)

484

531

485genericListStart :: OrgParser String

532genericListStart :: OrgParser String

486 -> OrgParser Int

533 -> OrgParser Int

@@ -499,7 +546,7 @@ orderedListStart = genericListStart orderedListMarker

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

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

500

547

501definitionListItem :: OrgParser Int

548definitionListItem :: OrgParser Int

502− -> OrgParser (Inlines, [Blocks])

549+ -> OrgParser (F (Inlines, [Blocks]))

503definitionListItem parseMarkerGetLength = try $ do

550definitionListItem parseMarkerGetLength = try $ do

504 markerLength <- parseMarkerGetLength

551 markerLength <- parseMarkerGetLength

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

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

@@ -507,12 +554,12 @@ definitionListItem parseMarkerGetLength = try $ do

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

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

508 term' <- parseFromString inline term

555 term' <- parseFromString inline term

509 contents' <- parseFromString parseBlocks $ first ++ cont

556 contents' <- parseFromString parseBlocks $ first ++ cont

510− return (term', [contents'])

557+ return $ (,) <$> term' <*> fmap (:[]) contents'

511

558

512

559

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

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

514listItem :: OrgParser Int

561listItem :: OrgParser Int

515− -> OrgParser Blocks

562+ -> OrgParser (F Blocks)

516listItem start = try $ do

563listItem start = try $ do

517 markerLength <- try start

564 markerLength <- try start

518 firstLine <- anyLineNewline

565 firstLine <- anyLineNewline

@@ -536,11 +583,11 @@ anyLineNewline = (++ "\n") <$> anyLine

536-- inline

583-- inline

537--

584--

538

585

539−inline :: OrgParser Inlines

586+inline :: OrgParser (F Inlines)

540inline =

587inline =

541 choice [ whitespace

588 choice [ whitespace

542 , linebreak

589 , linebreak

543− , link

590+ , linkOrImage

544 , str

591 , str

545 , endline

592 , endline

546 , emph

593 , emph

@@ -557,29 +604,29 @@ inline =

557 ] <* (guard =<< newlinesCountWithinLimits)

604 ] <* (guard =<< newlinesCountWithinLimits)

558 <?> "inline"

605 <?> "inline"

559

606

560−parseInlines :: OrgParser Inlines

607+parseInlines :: OrgParser (F Inlines)

561−parseInlines = trimInlines . mconcat <$> many1 inline

608+parseInlines = trimInlinesF . mconcat <$> many1 inline

562

609

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

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

564specialChars :: [Char]

611specialChars :: [Char]

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

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

566

613

567

614

568−whitespace :: OrgParser Inlines

615+whitespace :: OrgParser (F Inlines)

569−whitespace = B.space <$ skipMany1 spaceChar

616+whitespace = pure B.space <$ skipMany1 spaceChar

570− <* updateLastPreCharPos

617+ <* updateLastPreCharPos

571− <* updateLastForbiddenCharPos

618+ <* updateLastForbiddenCharPos

572 <?> "whitespace"

619 <?> "whitespace"

573

620

574−linebreak :: OrgParser Inlines

621+linebreak :: OrgParser (F Inlines)

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

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

576

623

577−str :: OrgParser Inlines

624+str :: OrgParser (F Inlines)

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

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

579− <* updateLastStrPos

626+ <* updateLastStrPos

580

627

581-- an endline character that can be treated as a space, not a structural break

628-- an endline character that can be treated as a space, not a structural break

582−endline :: OrgParser Inlines

629+endline :: OrgParser (F Inlines)

583endline = try $ do

630endline = try $ do

584 newline

631 newline

585 notFollowedBy blankline

632 notFollowedBy blankline

@@ -595,29 +642,29 @@ endline = try $ do

595 decEmphasisNewlinesCount

642 decEmphasisNewlinesCount

596 guard =<< newlinesCountWithinLimits

643 guard =<< newlinesCountWithinLimits

597 updateLastPreCharPos

644 updateLastPreCharPos

598− return B.space

645+ return . return $ B.space

599

646

600−link :: OrgParser Inlines

647+linkOrImage :: OrgParser (F Inlines)

601−link = explicitOrImageLink <|> selflinkOrImage <?> "link"

648+linkOrImage = explicitOrImageLink <|> selflinkOrImage <?> "link or image"

602

649

603−explicitOrImageLink :: OrgParser Inlines

650+explicitOrImageLink :: OrgParser (F Inlines)

604explicitOrImageLink = try $ do

651explicitOrImageLink = try $ do

605 char '['

652 char '['

606 src <- linkTarget

653 src <- linkTarget

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

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

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

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

609 char ']'

656 char ']'

610− return . B.link src ""

657+ return $ B.link src "" <$>

611− $ if isImageFilename src && isImageFilename title

658+ if isImageFilename src && isImageFilename title

612− then B.image title "" ""

659+ then return $ B.image title mempty mempty

613− else title'

660+ else title'

614

661

615−selflinkOrImage :: OrgParser Inlines

662+selflinkOrImage :: OrgParser (F Inlines)

616selflinkOrImage = try $ do

663selflinkOrImage = try $ do

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

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

618− return $ if isImageFilename src

665+ return . return $ if isImageFilename src

619− then B.image src "" ""

666+ then B.image src "" ""

620− else B.link src "" (B.str src)

667+ else B.link src "" (B.str src)

621

668

622selfTarget :: OrgParser String

669selfTarget :: OrgParser String

623selfTarget = try $ char '[' *> linkTarget <* char ']'

670selfTarget = try $ char '[' *> linkTarget <* char ']'

@@ -634,51 +681,50 @@ isImageFilename filename =

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

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

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

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

636

683

637−emph :: OrgParser Inlines

684+emph :: OrgParser (F Inlines)

638−emph = B.emph <$> emphasisBetween '/'

685+emph = fmap B.emph <$> emphasisBetween '/'

639

686

640−strong :: OrgParser Inlines

687+strong :: OrgParser (F Inlines)

641−strong = B.strong <$> emphasisBetween '*'

688+strong = fmap B.strong <$> emphasisBetween '*'

642

689

643−strikeout :: OrgParser Inlines

690+strikeout :: OrgParser (F Inlines)

644−strikeout = B.strikeout <$> emphasisBetween '+'

691+strikeout = fmap B.strikeout <$> emphasisBetween '+'

645

692

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

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

647−underline :: OrgParser Inlines

694+underline :: OrgParser (F Inlines)

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

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

649−

650−code :: OrgParser Inlines

651−code = B.code <$> verbatimBetween '='

652

696

653−verbatim :: OrgParser Inlines

697+code :: OrgParser (F Inlines)

654−verbatim = B.rawInline "" <$> verbatimBetween '~'

698+code = return . B.code <$> verbatimBetween '='

655

699

656−math :: OrgParser Inlines

700+verbatim :: OrgParser (F Inlines)

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

701+verbatim = return . B.rawInline "" <$> verbatimBetween '~'

658− , mathStringBetween '$'

659− , rawMathBetween "\$" "\$"

660− ]

661

702

662−displayMath :: OrgParser Inlines

703+subscript :: OrgParser (F Inlines)

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

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

664− , rawMathBetween "$$" "$$"

665− ]

666

705

667−subscript :: OrgParser Inlines

706+superscript :: OrgParser (F Inlines)

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

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

669

708

670−superscript :: OrgParser Inlines

709+math :: OrgParser (F Inlines)

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

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

711+ , mathStringBetween '$'

712+ , rawMathBetween "\$" "\$"

713+ ]

672

714

715+displayMath :: OrgParser (F Inlines)

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

717+ , rawMathBetween "$$" "$$"

718+ ]

673−symbol :: OrgParser Inlines

719+symbol :: OrgParser (F Inlines)

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

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

675 where updatePositions c

721 where updatePositions c

676 | c `elem` emphasisPreChars = c <$ updateLastPreCharPos

722 | c `elem` emphasisPreChars = c <$ updateLastPreCharPos

677 | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos

723 | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos

678 | otherwise = return c

724 | otherwise = return c

679

725

680emphasisBetween :: Char

726emphasisBetween :: Char

681− -> OrgParser Inlines

727+ -> OrgParser (F Inlines)

682emphasisBetween c = try $ do

728emphasisBetween c = try $ do

683 startEmphasisNewlinesCounting emphasisAllowedNewlines

729 startEmphasisNewlinesCounting emphasisAllowedNewlines

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

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

@@ -755,9 +801,9 @@ mathEnd c = try $ do

755

801

756enclosedInlines :: OrgParser a

802enclosedInlines :: OrgParser a

757 -> OrgParser b

803 -> OrgParser b

758− -> OrgParser Inlines

804+ -> OrgParser (F Inlines)

759enclosedInlines start end = try $

805enclosedInlines start end = try $

760− trimInlines . mconcat <$> enclosed start end inline

806+ trimInlinesF . mconcat <$> enclosed start end inline

761

807

762enclosedRaw :: OrgParser a

808enclosedRaw :: OrgParser a

763 -> OrgParser b

809 -> OrgParser b

@@ -843,7 +889,7 @@ notAfterForbiddenBorderChar = do

843 return $ lastFBCPos /= Just pos

889 return $ lastFBCPos /= Just pos

844

890

845-- | Read a sub- or superscript expression

891-- | Read a sub- or superscript expression

846−subOrSuperExpr :: OrgParser Inlines

892+subOrSuperExpr :: OrgParser (F Inlines)

847subOrSuperExpr = try $

893subOrSuperExpr = try $

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

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

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

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