6a2361c · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1256 from tarleb/org-reader-improvements

6a2361cJohn MacFarlane13 years ago

COPYRIGHT+7

compare with master

unifiedsplit

56Released under the GPL.

58+----------------------------------------------------------------------

59+src/Text/Pandoc/Readers/Org.hs

60+tests/Tests/Readers/Org.hs

62+

63+Released under the GPL.

64+

58----------------------------------------------------------------------

65----------------------------------------------------------------------

59src/Text/Pandoc/Biblio.hs

66src/Text/Pandoc/Biblio.hs

src/Text/Pandoc/Readers/Markdown.hs−17

@@ -861,22 +861,6 @@ definitionList = do

861 items <- fmap sequence $ many1 definitionListItem

862 return $ B.definitionList <$> fmap compactify'DL items

863

864−compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]

865−compactify'DL items =

866− let defs = concatMap snd items

867− defBlocks = reverse $ concatMap B.toList defs

868− isPara (Para _) = True

869− isPara _ = False

870− in case defBlocks of

871− (Para x:_) -> if not $ any isPara (drop 1 defBlocks)

872− then let (t,ds) = last items

873− lastDef = B.toList $ last ds

874− ds' = init ds ++

875− [B.fromList $ init lastDef ++ [Plain x]]

876− in init items ++ [(t, ds')]

877− else items

878− _ -> items

879−

880--

864--

881-- paragraph block

865-- paragraph block

882--

866--

@@ -1892,4 +1876,3 @@ doubleQuoted = try $ do

1892 (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return

1876 (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return

1893 (fmap B.doubleQuoted . trimInlinesF $ contents))

1877 (fmap B.doubleQuoted . trimInlinesF $ contents))

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

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

1895−

src/Text/Pandoc/Readers/Org.hs+422−204

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

1{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-

3{-

@@ -24,26 +25,32 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

25 Maintainer : Albert Krewinkel <tarleb@moltkeplatz.de>

26 Maintainer : Albert Krewinkel <tarleb@moltkeplatz.de>

27−Conversion of Org-Mode to 'Pandoc' document.

28+Conversion of org-mode formatted plain text to 'Pandoc' document.

28-}

29-}

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+ , parseFromString

41+ , updateLastStrPos )

37−import Text.Pandoc.Shared (compactify')

42+import Text.Pandoc.Shared (compactify', compactify'DL)

38−

43+

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

44+import Control.Applicative ( Applicative, pure

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

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

41−import Control.Monad (guard, when)

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

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

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 (intersperse, isPrefixOf, isSuffixOf)

51+import qualified Data.Map as M

45−import Data.Maybe (listToMaybe, fromMaybe)

52+import Data.Maybe (listToMaybe, fromMaybe, isJust)

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

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

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

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

49readOrg :: ReaderOptions -- ^ Reader options

56readOrg :: ReaderOptions -- ^ Reader options

@@ -53,27 +60,35 @@ readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

54type OrgParser = Parser [Char] OrgParserState

61type OrgParser = Parser [Char] OrgParserState

56−parseOrg:: OrgParser Pandoc

63+parseOrg :: OrgParser Pandoc

57parseOrg = do

64parseOrg = do

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

65+ blocks' <- parseBlocks

59 st <- getState

66 st <- getState

60− let meta = orgStateMeta st

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

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

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

63--

70--

64-- Parser State for Org

71-- Parser State for Org

65--

72--

74+type OrgNoteRecord = (String, F Blocks)

75+type OrgNoteTable = [OrgNoteRecord]

76+

77+type OrgBlockAttributes = M.Map String String

78+

67-- | Org-mode parser state

79-- | Org-mode parser state

68data OrgParserState = OrgParserState

80data OrgParserState = OrgParserState

69 { orgStateOptions :: ReaderOptions

81 { orgStateOptions :: ReaderOptions

82+ , orgStateBlockAttributes :: OrgBlockAttributes

70 , orgStateEmphasisCharStack :: [Char]

83 , orgStateEmphasisCharStack :: [Char]

71 , orgStateEmphasisNewlines :: Maybe Int

84 , orgStateEmphasisNewlines :: Maybe Int

72 , orgStateLastForbiddenCharPos :: Maybe SourcePos

85 , orgStateLastForbiddenCharPos :: Maybe SourcePos

73 , orgStateLastPreCharPos :: Maybe SourcePos

86 , orgStateLastPreCharPos :: Maybe SourcePos

74 , orgStateLastStrPos :: Maybe SourcePos

87 , orgStateLastStrPos :: Maybe SourcePos

75 , orgStateMeta :: Meta

88 , orgStateMeta :: Meta

76− } deriving (Show)

89+ , orgStateMeta' :: F Meta

90+ , orgStateNotes' :: OrgNoteTable

91+ }

78instance HasReaderOptions OrgParserState where

93instance HasReaderOptions OrgParserState where

79 extractReaderOptions = orgStateOptions

94 extractReaderOptions = orgStateOptions

@@ -90,14 +105,30 @@ instance Default OrgParserState where

90defaultOrgParserState :: OrgParserState

105defaultOrgParserState :: OrgParserState

91defaultOrgParserState = OrgParserState

106defaultOrgParserState = OrgParserState

92 { orgStateOptions = def

107 { orgStateOptions = def

108+ , orgStateBlockAttributes = M.empty

93 , orgStateEmphasisCharStack = []

109 , orgStateEmphasisCharStack = []

94 , orgStateEmphasisNewlines = Nothing

110 , orgStateEmphasisNewlines = Nothing

95 , orgStateLastForbiddenCharPos = Nothing

111 , orgStateLastForbiddenCharPos = Nothing

96 , orgStateLastPreCharPos = Nothing

112 , orgStateLastPreCharPos = Nothing

97 , orgStateLastStrPos = Nothing

113 , orgStateLastStrPos = Nothing

98 , orgStateMeta = nullMeta

114 , orgStateMeta = nullMeta

115+ , orgStateMeta' = return nullMeta

116+ , orgStateNotes' = []

99 }

117 }

100

118

119+addBlockAttribute :: String -> String -> OrgParser ()

120+addBlockAttribute key val = updateState $ \s ->

121+ let attrs = orgStateBlockAttributes s

122+ in s{ orgStateBlockAttributes = M.insert key val attrs }

123+

124+lookupBlockAttribute :: String -> OrgParser (Maybe String)

125+lookupBlockAttribute key =

126+ M.lookup key . orgStateBlockAttributes <$> getState

127+

128+resetBlockAttributes :: OrgParser ()

129+resetBlockAttributes = updateState $ \s ->

130+ s{ orgStateBlockAttributes = orgStateBlockAttributes def }

131+

101updateLastStrPos :: OrgParser ()

132updateLastStrPos :: OrgParser ()

102updateLastStrPos = getPosition >>= \p ->

133updateLastStrPos = getPosition >>= \p ->

103 updateState $ \s -> s{ orgStateLastStrPos = Just p }

134 updateState $ \s -> s{ orgStateLastStrPos = Just p }

@@ -111,19 +142,19 @@ updateLastPreCharPos = getPosition >>= \p ->

111 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}

142 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}

112

143

113pushToInlineCharStack :: Char -> OrgParser ()

144pushToInlineCharStack :: Char -> OrgParser ()

114−pushToInlineCharStack c = updateState $ \st ->

145+pushToInlineCharStack c = updateState $ \s ->

115− st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st }

146+ s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }

116

147

117popInlineCharStack :: OrgParser ()

148popInlineCharStack :: OrgParser ()

118−popInlineCharStack = updateState $ \st ->

149+popInlineCharStack = updateState $ \s ->

119− st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st }

150+ s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }

120

151

121surroundingEmphasisChar :: OrgParser [Char]

152surroundingEmphasisChar :: OrgParser [Char]

122surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState

153surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState

123

154

124startEmphasisNewlinesCounting :: Int -> OrgParser ()

155startEmphasisNewlinesCounting :: Int -> OrgParser ()

125startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->

156startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->

126− s { orgStateEmphasisNewlines = Just maxNewlines }

157+ s{ orgStateEmphasisNewlines = Just maxNewlines }

127

158

128decEmphasisNewlinesCount :: OrgParser ()

159decEmphasisNewlinesCount :: OrgParser ()

129decEmphasisNewlinesCount = updateState $ \s ->

160decEmphasisNewlinesCount = updateState $ \s ->

@@ -138,6 +169,48 @@ resetEmphasisNewlines :: OrgParser ()

138resetEmphasisNewlines = updateState $ \s ->

169resetEmphasisNewlines = updateState $ \s ->

139 s{ orgStateEmphasisNewlines = Nothing }

170 s{ orgStateEmphasisNewlines = Nothing }

140

171

172+addToNotesTable :: OrgNoteRecord -> OrgParser ()

173+addToNotesTable note = do

174+ oldnotes <- orgStateNotes' <$> getState

175+ updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

176+

177+-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts

178+-- of the state saved and restored.

179+parseFromString :: OrgParser a -> String -> OrgParser a

180+parseFromString parser str' = do

181+ oldLastPreCharPos <- orgStateLastPreCharPos <$> getState

182+ updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }

183+ result <- P.parseFromString parser str'

184+ updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos }

185+ return result

186+

187+

188+--

189+-- Adaptions and specializations of parsing utilities

190+--

191+

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

193+ } deriving (Monad, Applicative, Functor)

194+

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

196+runF = runReader . unF

197+

198+askF :: F OrgParserState

199+askF = F ask

200+

201+asksF :: (OrgParserState -> a) -> F a

202+asksF f = F $ asks f

203+

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

205+ mempty = return mempty

206+ mappend = liftM2 mappend

207+ mconcat = fmap mconcat . sequence

208+

209+trimInlinesF :: F Inlines -> F Inlines

210+trimInlinesF = liftM trimInlines

211+

212+

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

141newline :: OrgParser Char

214newline :: OrgParser Char

142newline =

215newline =

143 P.newline

216 P.newline

@@ -148,37 +221,83 @@ newline =

148-- parsing blocks

221-- parsing blocks

149--

222--

150

223

151−parseBlocks :: OrgParser Blocks

224+parseBlocks :: OrgParser (F Blocks)

152parseBlocks = mconcat <$> manyTill block eof

225parseBlocks = mconcat <$> manyTill block eof

153

226

154−block :: OrgParser Blocks

227+block :: OrgParser (F Blocks)

155block = choice [ mempty <$ blanklines

228block = choice [ mempty <$ blanklines

229+ , optionalAttributes $ choice

156− , orgBlock

230+ [ orgBlock

231+ , figure

232+ , table

233+ ]

157 , example

234 , example

158 , drawer

235 , drawer

159− , figure

160 , specialLine

236 , specialLine

161 , header

237 , header

162− , hline

238+ , return <$> hline

163 , list

239 , list

164− , table

240+ , latexFragment

241+ , noteBlock

165 , paraOrPlain

242 , paraOrPlain

166 ] <?> "block"

243 ] <?> "block"

167

244

245+optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)

246+optionalAttributes parser = try $

247+ resetBlockAttributes *> parseBlockAttributes *> parser

248+

249+parseBlockAttributes :: OrgParser ()

250+parseBlockAttributes = do

251+ attrs <- many attribute

252+ () <$ mapM (uncurry parseAndAddAttribute) attrs

253+ where

254+ attribute :: OrgParser (String, String)

255+ attribute = try $ do

256+ key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':')

257+ val <- skipSpaces *> anyLine

258+ return (map toLower key, val)

259+

260+parseAndAddAttribute :: String -> String -> OrgParser ()

261+parseAndAddAttribute key value = do

262+ let key' = map toLower key

263+ () <$ addBlockAttribute key' value

264+

265+lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))

266+lookupInlinesAttr attr = try $ do

267+ val <- lookupBlockAttribute attr

268+ maybe (return Nothing)

269+ (fmap Just . parseFromString parseInlines)

270+ val

271+

272+

168--

273--

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

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

170--

275--

171

276

172−orgBlock :: OrgParser Blocks

277+orgBlock :: OrgParser (F Blocks)

173orgBlock = try $ do

278orgBlock = try $ do

174 (indent, blockType, args) <- blockHeader

279 (indent, blockType, args) <- blockHeader

175− blockStr <- rawBlockContent indent blockType

280+ content <- rawBlockContent indent blockType

281+ contentBlocks <- parseFromString parseBlocks (content ++ "\n")

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

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

177 case blockType of

283 case blockType of

178 "comment" -> return mempty

284 "comment" -> return mempty

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

285+ "html" -> returnF $ B.rawBlock "html" content

286+ "latex" -> returnF $ B.rawBlock "latex" content

287+ "ascii" -> returnF $ B.rawBlock "ascii" content

288+ "example" -> returnF $ exampleCode content

289+ "quote" -> return $ B.blockQuote <$> contentBlocks

290+ "verse" -> parseVerse content

291+ "src" -> codeBlockWithAttr classArgs content

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

292+ _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks

293+ where

294+ returnF :: a -> OrgParser (F a)

295+ returnF = return . return

296+

297+ parseVerse :: String -> OrgParser (F Blocks)

298+ parseVerse cs =

299+ fmap B.para . mconcat . intersperse (pure B.linebreak)

181− <$> parseFromString parseBlocks blockStr

300+ <$> mapM (parseFromString parseInlines) (lines cs)

182

301

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

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

184blockHeader = (,,) <$> blockIndent

303blockHeader = (,,) <$> blockIndent

@@ -188,6 +307,18 @@ blockHeader = (,,) <$> blockIndent

188 blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)

307 blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)

189 blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline

308 blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline

190

309

310+codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks)

311+codeBlockWithAttr classArgs content = do

312+ identifier <- fromMaybe "" <$> lookupBlockAttribute "name"

313+ caption <- lookupInlinesAttr "caption"

314+ let codeBlck = B.codeBlockWith (identifier, classArgs, []) content

315+ return $ maybe (pure codeBlck) (labelDiv codeBlck) caption

316+ where

317+ labelDiv blk value =

318+ B.divWith nullAttr <$> (mappend <$> labelledBlock value

319+ <*> pure blk)

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

321+

191rawBlockContent :: Int -> String -> OrgParser String

322rawBlockContent :: Int -> String -> OrgParser String

192rawBlockContent indent blockType =

323rawBlockContent indent blockType =

193 unlines . map commaEscaped <$> manyTill indentedLine blockEnder

324 unlines . map commaEscaped <$> manyTill indentedLine blockEnder

@@ -222,15 +353,18 @@ commaEscaped (',':cs@('*':_)) = cs

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

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

223commaEscaped cs = cs

354commaEscaped cs = cs

224

355

225−example :: OrgParser Blocks

356+example :: OrgParser (F Blocks)

226−example = try $

357+example = try $ do

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

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

359+

360+exampleCode :: String -> Blocks

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

228

362

229exampleLine :: OrgParser String

363exampleLine :: OrgParser String

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

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

231

365

232-- Drawers for properties or a logbook

366-- Drawers for properties or a logbook

233−drawer :: OrgParser Blocks

367+drawer :: OrgParser (F Blocks)

234drawer = try $ do

368drawer = try $ do

235 drawerStart

369 drawerStart

236 manyTill drawerLine (try drawerEnd)

370 manyTill drawerLine (try drawerEnd)

@@ -256,41 +390,31 @@ drawerEnd = try $

256--

390--

257

391

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

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

259−figure :: OrgParser Blocks

393+figure :: OrgParser (F Blocks)

260figure = try $ do

394figure = try $ do

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

395+ (cap, nam) <- nameAndCaption

262− <$> nameAndOrCaption

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

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

264 guard (isImageFilename src)

397 guard (isImageFilename src)

398+ return $ do

399+ cap' <- cap

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

400+ return $ B.para $ B.image src nam cap'

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

267− then cs

268− else "fig:" ++ cs

269−

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

271−nameAndOrCaption = try $ nameFirst <|> captionFirst

272 where

401 where

273− nameFirst = try $ do

402+ nameAndCaption =

274− n <- name

403+ do

275− c <- optionMaybe caption

404+ maybeCap <- lookupInlinesAttr "caption"

276− return (Just n, c)

405+ maybeNam <- lookupBlockAttribute "name"

277− captionFirst = try $ do

406+ guard $ isJust maybeCap || isJust maybeNam

278− c <- caption

407+ return ( fromMaybe mempty maybeCap

279− n <- optionMaybe name

408+ , maybe mempty withFigPrefix maybeNam )

280− return (n, Just c)

409+ withFigPrefix cs =

281−

410+ if "fig:" `isPrefixOf` cs

282−caption :: OrgParser Inlines

411+ then cs

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

412+ else "fig:" ++ cs

284−

285−name :: OrgParser String

286−name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline

287−

288−annotation :: String -> OrgParser String

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

290

413

414+--

291-- Comments, Options and Metadata

415-- Comments, Options and Metadata

292−specialLine :: OrgParser Blocks

416+specialLine :: OrgParser (F Blocks)

293−specialLine = try $ metaLine <|> commentLine

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

294

418

295metaLine :: OrgParser Blocks

419metaLine :: OrgParser Blocks

296metaLine = try $ metaLineStart *> declarationLine

420metaLine = try $ metaLineStart *> declarationLine

@@ -308,29 +432,41 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

308

432

309declarationLine :: OrgParser Blocks

433declarationLine :: OrgParser Blocks

310declarationLine = try $ do

434declarationLine = try $ do

435+ key <- metaKey

436+ inlinesF <- metaInlines

437+ updateState $ \st ->

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

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

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

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

313 return mempty

440 return mempty

314

441

315−metaValue :: OrgParser MetaValue

442+metaInlines :: OrgParser (F MetaValue)

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

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

317

444

318metaKey :: OrgParser String

445metaKey :: OrgParser String

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

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

320 <* char ':'

447 <* char ':'

321 <* skipSpaces

448 <* skipSpaces

322

449

450+--

451+-- Headers

452+--

453+

323-- | Headers

454-- | Headers

324−header :: OrgParser Blocks

455+header :: OrgParser (F Blocks)

325−header = try $

456+header = try $ do

326− B.header <$> headerStart

457+ level <- headerStart

327− <*> inlinesTillNewline

458+ title <- inlinesTillNewline

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

328

460

329headerStart :: OrgParser Int

461headerStart :: OrgParser Int

330headerStart = try $

462headerStart = try $

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

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

332

464

465+

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

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

468+

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

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

334hline :: OrgParser Blocks

470hline :: OrgParser Blocks

335hline = try $ do

471hline = try $ do

336 skipSpaces

472 skipSpaces

@@ -344,27 +480,30 @@ hline = try $ do

344-- Tables

480-- Tables

345--

481--

346

482

347−data OrgTableRow = OrgContentRow [Blocks]

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

348 | OrgAlignRow [Alignment]

484 | OrgAlignRow [Alignment]

349 | OrgHlineRow

485 | OrgHlineRow

350− deriving (Eq, Show)

351

486

352data OrgTable = OrgTable

487data OrgTable = OrgTable

353 { orgTableColumns :: Int

488 { orgTableColumns :: Int

354 , orgTableAlignments :: [Alignment]

489 , orgTableAlignments :: [Alignment]

355 , orgTableHeader :: [Blocks]

490 , orgTableHeader :: [Blocks]

356 , orgTableRows :: [[Blocks]]

491 , orgTableRows :: [[Blocks]]

357− } deriving (Eq, Show)

492+ }

358

493

359−table :: OrgParser Blocks

494+table :: OrgParser (F Blocks)

360table = try $ do

495table = try $ do

361 lookAhead tableStart

496 lookAhead tableStart

497+ do

498+ rows <- tableRows

499+ cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"

362− orgToPandocTable . normalizeTable . rowsToTable <$> tableRows

500+ return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows

363

501

364orgToPandocTable :: OrgTable

502orgToPandocTable :: OrgTable

503+ -> Inlines

365 -> Blocks

504 -> Blocks

366−orgToPandocTable (OrgTable _ aligns heads lns) =

505+orgToPandocTable (OrgTable _ aligns heads lns) caption =

367− B.table "" (zip aligns $ repeat 0) heads lns

506+ B.table caption (zip aligns $ repeat 0) heads lns

368

507

369tableStart :: OrgParser Char

508tableStart :: OrgParser Char

370tableStart = try $ skipSpaces *> char '|'

509tableStart = try $ skipSpaces *> char '|'

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

374

513

375tableContentRow :: OrgParser OrgTableRow

514tableContentRow :: OrgParser OrgTableRow

376tableContentRow = try $

515tableContentRow = try $

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

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

378

517

379−tableContentCell :: OrgParser Blocks

518+tableContentCell :: OrgParser (F Blocks)

380tableContentCell = try $

519tableContentCell = try $

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

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

382

521

383endOfCell :: OrgParser Char

522endOfCell :: OrgParser Char

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

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

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

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

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

411

550

412rowsToTable :: [OrgTableRow]

551rowsToTable :: [OrgTableRow]

413− -> OrgTable

552+ -> F OrgTable

414−rowsToTable = foldl' (flip rowToContent) zeroTable

553+rowsToTable = foldM (flip rowToContent) zeroTable

415 where zeroTable = OrgTable 0 mempty mempty mempty

554 where zeroTable = OrgTable 0 mempty mempty mempty

416

555

417normalizeTable :: OrgTable

556normalizeTable :: OrgTable

@@ -430,57 +569,113 @@ normalizeTable (OrgTable cols aligns heads lns) =

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

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

431rowToContent :: OrgTableRow

570rowToContent :: OrgTableRow

432 -> OrgTable

571 -> OrgTable

433− -> OrgTable

572+ -> F OrgTable

434−rowToContent OrgHlineRow = maybeBodyToHeader

573+rowToContent OrgHlineRow t = maybeBodyToHeader t

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

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

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

575+rowToContent (OrgContentRow rf) t = do

576+ rs <- rf

577+ setLongestRow rs =<< appendToBody rs t

437

578

438setLongestRow :: [a]

579setLongestRow :: [a]

439 -> OrgTable

580 -> OrgTable

440− -> OrgTable

581+ -> F OrgTable

582+setLongestRow rs t =

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

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

442

584

443maybeBodyToHeader :: OrgTable

585maybeBodyToHeader :: OrgTable

444− -> OrgTable

586+ -> F OrgTable

445maybeBodyToHeader t = case t of

587maybeBodyToHeader t = case t of

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

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

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

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

448− _ -> t

590+ _ -> return t

449

591

450appendToBody :: [Blocks]

592appendToBody :: [Blocks]

451 -> OrgTable

593 -> OrgTable

452− -> OrgTable

594+ -> F OrgTable

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

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

454

596

455setAligns :: [Alignment]

597setAligns :: [Alignment]

456 -> OrgTable

598 -> OrgTable

457− -> OrgTable

599+ -> F OrgTable

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

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

601+

602+

603+--

604+-- LaTeX fragments

605+--

606+latexFragment :: OrgParser (F Blocks)

607+latexFragment = try $ do

608+ envName <- latexEnvStart

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

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

611+ where

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

613+ , c

614+ , "\\end{", e, "}\n"

615+ ]

616+

617+latexEnvStart :: OrgParser String

618+latexEnvStart = try $ do

619+ skipSpaces *> string "\\begin{"

620+ *> latexEnvName

621+ <* string "}"

622+ <* blankline

623+

624+latexEnd :: String -> OrgParser ()

625+latexEnd envName = try $

626+ () <$ skipSpaces

627+ <* string ("\\end{" ++ envName ++ "}")

628+ <* blankline

629+

630+-- | Parses a LaTeX environment name.

631+latexEnvName :: OrgParser String

632+latexEnvName = try $ do

633+ mappend <$> many1 alphaNum

634+ <*> option "" (string "*")

635+

636+

637+--

638+-- Footnote defintions

639+--

640+noteBlock :: OrgParser (F Blocks)

641+noteBlock = try $ do

642+ ref <- noteMarker <* skipSpaces

643+ content <- mconcat <$> blocksTillHeaderOrNote

644+ addToNotesTable (ref, content)

645+ return mempty

646+ where

647+ blocksTillHeaderOrNote =

648+ many1Till block (eof <|> () <$ lookAhead noteMarker

649+ <|> () <$ lookAhead headerStart)

459

650

460-- Paragraphs or Plain text

651-- Paragraphs or Plain text

461−paraOrPlain :: OrgParser Blocks

652+paraOrPlain :: OrgParser (F Blocks)

462paraOrPlain = try $

653paraOrPlain = try $

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

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

464

655

465−inlinesTillNewline :: OrgParser Inlines

656+inlinesTillNewline :: OrgParser (F Inlines)

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

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

467

658

468

659

469--

660--

470-- list blocks

661-- list blocks

471--

662--

472

663

473−list :: OrgParser Blocks

664+list :: OrgParser (F Blocks)

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

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

475

666

476−definitionList :: OrgParser Blocks

667+definitionList :: OrgParser (F Blocks)

668+definitionList = fmap B.definitionList . fmap compactify'DL . sequence

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

669+ <$> many1 (definitionListItem bulletListStart)

478

670

479−bulletList :: OrgParser Blocks

671+bulletList :: OrgParser (F Blocks)

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

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

673+ <$> many1 (listItem bulletListStart)

481

674

482−orderedList :: OrgParser Blocks

675+orderedList :: OrgParser (F Blocks)

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

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

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

678+ <$> many1 (listItem orderedListStart)

484

679

485genericListStart :: OrgParser String

680genericListStart :: OrgParser String

486 -> OrgParser Int

681 -> OrgParser Int

@@ -499,33 +694,36 @@ orderedListStart = genericListStart orderedListMarker

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

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

500

695

501definitionListItem :: OrgParser Int

696definitionListItem :: OrgParser Int

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

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

503definitionListItem parseMarkerGetLength = try $ do

698definitionListItem parseMarkerGetLength = try $ do

504 markerLength <- parseMarkerGetLength

699 markerLength <- parseMarkerGetLength

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

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

506 first <- anyLineNewline

701 first <- anyLineNewline

702+ blank <- option "" ("\n" <$ blankline)

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

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

508 term' <- parseFromString inline term

704 term' <- parseFromString inline term

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

705+ contents' <- parseFromString parseBlocks $ first ++ blank ++ cont

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

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

511

707

512

708

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

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

514listItem :: OrgParser Int

710listItem :: OrgParser Int

515− -> OrgParser Blocks

711+ -> OrgParser (F Blocks)

516listItem start = try $ do

712listItem start = try $ do

517 markerLength <- try start

713 markerLength <- try start

518 firstLine <- anyLineNewline

714 firstLine <- anyLineNewline

715+ blank <- option "" ("\n" <$ blankline)

519 rest <- concat <$> many (listContinuation markerLength)

716 rest <- concat <$> many (listContinuation markerLength)

520− parseFromString parseBlocks $ firstLine ++ rest

717+ parseFromString parseBlocks $ firstLine ++ blank ++ rest

521

718

522-- continuation of a list item - indented and separated by blankline or endline.

719-- continuation of a list item - indented and separated by blankline or endline.

523-- Note: nested lists are parsed as continuations.

720-- Note: nested lists are parsed as continuations.

524listContinuation :: Int

721listContinuation :: Int

525 -> OrgParser String

722 -> OrgParser String

526listContinuation markerLength = try $

723listContinuation markerLength = try $

527− mappend <$> many blankline

724+ notFollowedBy' blankline

528− <*> (concat <$> many1 listLine)

725+ *> (mappend <$> (concat <$> many1 listLine)

726+ <*> many blankline)

529 where listLine = try $ indentWith markerLength *> anyLineNewline

727 where listLine = try $ indentWith markerLength *> anyLineNewline

530

728

531anyLineNewline :: OrgParser String

729anyLineNewline :: OrgParser String

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

536-- inline

734-- inline

537--

735--

538

736

539−inline :: OrgParser Inlines

737+inline :: OrgParser (F Inlines)

540inline =

738inline =

541 choice [ whitespace

739 choice [ whitespace

542 , linebreak

740 , linebreak

543− , link

741+ , footnote

742+ , linkOrImage

544 , str

743 , str

545 , endline

744 , endline

546 , emph

745 , emph

@@ -557,67 +756,104 @@ inline =

557 ] <* (guard =<< newlinesCountWithinLimits)

756 ] <* (guard =<< newlinesCountWithinLimits)

558 <?> "inline"

757 <?> "inline"

559

758

560−parseInlines :: OrgParser Inlines

759+parseInlines :: OrgParser (F Inlines)

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

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

562

761

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

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

564specialChars :: [Char]

763specialChars :: [Char]

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

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

566

765

567

766

568−whitespace :: OrgParser Inlines

767+whitespace :: OrgParser (F Inlines)

569−whitespace = B.space <$ skipMany1 spaceChar

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

570− <* updateLastPreCharPos

769+ <* updateLastPreCharPos

571− <* updateLastForbiddenCharPos

770+ <* updateLastForbiddenCharPos

572 <?> "whitespace"

771 <?> "whitespace"

573

772

574−linebreak :: OrgParser Inlines

773+linebreak :: OrgParser (F Inlines)

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

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

576

775

577−str :: OrgParser Inlines

776+str :: OrgParser (F Inlines)

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

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

579− <* updateLastStrPos

778+ <* updateLastStrPos

580

779

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

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

781+-- break. This should reflect the values of the Emacs variable

782+-- @org-element-pagaraph-separate@.

582−endline :: OrgParser Inlines

783+endline :: OrgParser (F Inlines)

583endline = try $ do

784endline = try $ do

584 newline

785 newline

585 notFollowedBy blankline

786 notFollowedBy blankline

586 notFollowedBy' exampleLine

787 notFollowedBy' exampleLine

587 notFollowedBy' hline

788 notFollowedBy' hline

789+ notFollowedBy' noteMarker

588 notFollowedBy' tableStart

790 notFollowedBy' tableStart

589 notFollowedBy' drawerStart

791 notFollowedBy' drawerStart

590 notFollowedBy' headerStart

792 notFollowedBy' headerStart

591 notFollowedBy' metaLineStart

793 notFollowedBy' metaLineStart

794+ notFollowedBy' latexEnvStart

592 notFollowedBy' commentLineStart

795 notFollowedBy' commentLineStart

593 notFollowedBy' bulletListStart

796 notFollowedBy' bulletListStart

594 notFollowedBy' orderedListStart

797 notFollowedBy' orderedListStart

595 decEmphasisNewlinesCount

798 decEmphasisNewlinesCount

596 guard =<< newlinesCountWithinLimits

799 guard =<< newlinesCountWithinLimits

597 updateLastPreCharPos

800 updateLastPreCharPos

598− return B.space

801+ return . return $ B.space

802+

803+footnote :: OrgParser (F Inlines)

804+footnote = try $ inlineNote <|> referencedNote

805+

806+inlineNote :: OrgParser (F Inlines)

807+inlineNote = try $ do

808+ string "[fn:"

809+ ref <- many alphaNum

810+ char ':'

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

812+ when (not $ null ref) $

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

814+ return $ B.note <$> note

815+

816+referencedNote :: OrgParser (F Inlines)

817+referencedNote = try $ do

818+ ref <- noteMarker

819+ return $ do

820+ notes <- asksF orgStateNotes'

821+ case lookup ref notes of

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

823+ Just contents -> do

824+ st <- askF

825+ let contents' = runF contents st{ orgStateNotes' = [] }

826+ return $ B.note contents'

827+

828+noteMarker :: OrgParser String

829+noteMarker = try $ do

830+ char '['

831+ choice [ many1Till digit (char ']')

832+ , (++) <$> string "fn:"

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

834+ ]

599

835

600−link :: OrgParser Inlines

836+linkOrImage :: OrgParser (F Inlines)

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

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

602

838

603−explicitOrImageLink :: OrgParser Inlines

839+explicitOrImageLink :: OrgParser (F Inlines)

604explicitOrImageLink = try $ do

840explicitOrImageLink = try $ do

605 char '['

841 char '['

606 src <- linkTarget

842 src <- linkTarget

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

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

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

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

609 char ']'

845 char ']'

610− return . B.link src ""

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

611− $ if isImageFilename src && isImageFilename title

847+ if isImageFilename src && isImageFilename title

612− then B.image title "" ""

848+ then return $ B.image title mempty mempty

613− else title'

849+ else title'

614

850

615−selflinkOrImage :: OrgParser Inlines

851+selflinkOrImage :: OrgParser (F Inlines)

616selflinkOrImage = try $ do

852selflinkOrImage = try $ do

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

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

618− return $ if isImageFilename src

854+ return . return $ if isImageFilename src

619− then B.image src "" ""

855+ then B.image src "" ""

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

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

621

857

622selfTarget :: OrgParser String

858selfTarget :: OrgParser String

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

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

@@ -628,57 +864,56 @@ linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]")

628isImageFilename :: String -> Bool

864isImageFilename :: String -> Bool

629isImageFilename filename =

865isImageFilename filename =

630 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

866 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

631− any (\x -> (x++":") `isPrefixOf` filename) protocols ||

867+ (any (\x -> (x++":") `isPrefixOf` filename) protocols ||

632− ':' `notElem` filename

868+ ':' `notElem` filename)

633 where

869 where

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

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

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

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

636

872

637−emph :: OrgParser Inlines

873+emph :: OrgParser (F Inlines)

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

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

639

875

640−strong :: OrgParser Inlines

876+strong :: OrgParser (F Inlines)

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

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

642

878

643−strikeout :: OrgParser Inlines

879+strikeout :: OrgParser (F Inlines)

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

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

645

881

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

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

647−underline :: OrgParser Inlines

883+underline :: OrgParser (F Inlines)

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

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

649−

650−code :: OrgParser Inlines

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

652

885

653−verbatim :: OrgParser Inlines

886+code :: OrgParser (F Inlines)

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

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

655

888

656−math :: OrgParser Inlines

889+verbatim :: OrgParser (F Inlines)

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

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

658− , mathStringBetween '$'

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

660− ]

661

891

662−displayMath :: OrgParser Inlines

892+subscript :: OrgParser (F Inlines)

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

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

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

665− ]

666

894

667−subscript :: OrgParser Inlines

895+superscript :: OrgParser (F Inlines)

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

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

669

897

670−superscript :: OrgParser Inlines

898+math :: OrgParser (F Inlines)

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

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

900+ , mathStringBetween '$'

901+ , rawMathBetween "\$" "\$"

902+ ]

672

903

904+displayMath :: OrgParser (F Inlines)

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

906+ , rawMathBetween "$$" "$$"

907+ ]

673−symbol :: OrgParser Inlines

908+symbol :: OrgParser (F Inlines)

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

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

675 where updatePositions c

910 where updatePositions c

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

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

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

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

678 | otherwise = return c

913 | otherwise = return c

679

914

680emphasisBetween :: Char

915emphasisBetween :: Char

681− -> OrgParser Inlines

916+ -> OrgParser (F Inlines)

682emphasisBetween c = try $ do

917emphasisBetween c = try $ do

683 startEmphasisNewlinesCounting emphasisAllowedNewlines

918 startEmphasisNewlinesCounting emphasisAllowedNewlines

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

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

@@ -711,7 +946,7 @@ math1CharBetween c = try $ do

711 char c

946 char c

712 res <- noneOf $ c:mathForbiddenBorderChars

947 res <- noneOf $ c:mathForbiddenBorderChars

713 char c

948 char c

714− eof <|> lookAhead (oneOf mathPostChars) *> return ()

949+ eof <|> () <$ lookAhead (oneOf mathPostChars)

715 return [res]

950 return [res]

716

951

717rawMathBetween :: String

952rawMathBetween :: String

@@ -734,12 +969,12 @@ emphasisEnd :: Char -> OrgParser Char

734emphasisEnd c = try $ do

969emphasisEnd c = try $ do

735 guard =<< notAfterForbiddenBorderChar

970 guard =<< notAfterForbiddenBorderChar

736 char c

971 char c

737− eof <|> lookAhead (surroundingEmphasisChar >>= \x ->

972+ eof <|> () <$ lookAhead acceptablePostChars

738− oneOf (x ++ emphasisPostChars))

739− *> return ()

740 updateLastStrPos

973 updateLastStrPos

741 popInlineCharStack

974 popInlineCharStack

742 return c

975 return c

976+ where acceptablePostChars =

977+ surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)

743

978

744mathStart :: Char -> OrgParser Char

979mathStart :: Char -> OrgParser Char

745mathStart c = try $

980mathStart c = try $

@@ -749,15 +984,15 @@ mathEnd :: Char -> OrgParser Char

749mathEnd c = try $ do

984mathEnd c = try $ do

750 res <- noneOf (c:mathForbiddenBorderChars)

985 res <- noneOf (c:mathForbiddenBorderChars)

751 char c

986 char c

752− eof <|> lookAhead (oneOf mathPostChars *> pure ())

987+ eof <|> () <$ lookAhead (oneOf mathPostChars)

753 return res

988 return res

754

989

755

990

756enclosedInlines :: OrgParser a

991enclosedInlines :: OrgParser a

757 -> OrgParser b

992 -> OrgParser b

758− -> OrgParser Inlines

993+ -> OrgParser (F Inlines)

759enclosedInlines start end = try $

994enclosedInlines start end = try $

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

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

761

996

762enclosedRaw :: OrgParser a

997enclosedRaw :: OrgParser a

763 -> OrgParser b

998 -> OrgParser b

@@ -843,25 +1078,13 @@ notAfterForbiddenBorderChar = do

843 return $ lastFBCPos /= Just pos

1078 return $ lastFBCPos /= Just pos

844

1079

845-- | Read a sub- or superscript expression

1080-- | Read a sub- or superscript expression

846−subOrSuperExpr :: OrgParser Inlines

1081+subOrSuperExpr :: OrgParser (F Inlines)

847−subOrSuperExpr = try $ do

1082+subOrSuperExpr = try $

848− choice [ balancedSexp '{' '}'

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

849− , balancedSexp '(' ')' >>= return . enclosing ('(', ')')

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

850 , simpleSubOrSuperString

1085 , simpleSubOrSuperString

851 ] >>= parseFromString (mconcat <$> many inline)

1086 ] >>= parseFromString (mconcat <$> many inline)

852−

1087+ where enclosing (left, right) s = left : s ++ [right]

853−-- | Read a balanced sexp

854−balancedSexp :: Char

855− -> Char

856− -> OrgParser String

857−balancedSexp l r = try $ do

858− char l

859− res <- concat <$> many ( many1 (noneOf ([l, r] ++ "\n\r"))

860− <|> try (string [l, r])

861− <|> enclosing (l, r) <$> balancedSexp l r

862− )

863− char r

864− return res

865

1088

866simpleSubOrSuperString :: OrgParser String

1089simpleSubOrSuperString :: OrgParser String

867simpleSubOrSuperString = try $

1090simpleSubOrSuperString = try $

@@ -869,8 +1092,3 @@ simpleSubOrSuperString = try $

869 , mappend <$> option [] ((:[]) <$> oneOf "+-")

1092 , mappend <$> option [] ((:[]) <$> oneOf "+-")

870 <*> many1 alphaNum

1093 <*> many1 alphaNum

871 ]

1094 ]

872−

873−enclosing :: (a, a)

874− -> [a]

875− -> [a]

876−enclosing (left, right) s = left : s ++ [right]

src/Text/Pandoc/Shared.hs+17−3

@@ -56,6 +56,7 @@ module Text.Pandoc.Shared (

56 stringify,

57 compactify,

58 compactify',

59+ compactify'DL,

59 Element (..),

60 Element (..),

60 hierarchicalize,

61 hierarchicalize,

61 uniqueIdent,

62 uniqueIdent,

@@ -82,7 +83,7 @@ module Text.Pandoc.Shared (

82import Text.Pandoc.Definition

83import Text.Pandoc.Definition

83import Text.Pandoc.Walk

84import Text.Pandoc.Walk

84import Text.Pandoc.Generic

85import Text.Pandoc.Generic

85−import Text.Pandoc.Builder (Blocks, ToMetaValue(..))

86+import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))

86import qualified Text.Pandoc.Builder as B

87import qualified Text.Pandoc.Builder as B

87import qualified Text.Pandoc.UTF8 as UTF8

88import qualified Text.Pandoc.UTF8 as UTF8

88import System.Environment (getProgName)

89import System.Environment (getProgName)

@@ -435,6 +436,21 @@ compactify' items =

435 _ -> items

436 _ -> items

437 _ -> items

437

438

439+-- | Like @compactify'@, but akts on items of definition lists.

440+compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]

441+compactify'DL items =

442+ let defs = concatMap snd items

443+ defBlocks = reverse $ concatMap B.toList defs

444+ in case defBlocks of

445+ (Para x:_) -> if not $ any isPara (drop 1 defBlocks)

446+ then let (t,ds) = last items

447+ lastDef = B.toList $ last ds

448+ ds' = init ds ++

449+ [B.fromList $ init lastDef ++ [Plain x]]

450+ in init items ++ [(t, ds')]

451+ else items

452+ _ -> items

453+

438isPara :: Block -> Bool

454isPara :: Block -> Bool

439isPara (Para _) = True

455isPara (Para _) = True

440isPara _ = False

456isPara _ = False

@@ -698,5 +714,3 @@ safeRead s = case reads s of

698 (d,x):_

714 (d,x):_

699 | all isSpace x -> return d

715 | all isSpace x -> return d

700 _ -> fail $ "Could not read `" ++ s ++ "'"

716 _ -> fail $ "Could not read `" ++ s ++ "'"

701−

702−

tests/Tests/Readers/Org.hs+196−29

@@ -8,7 +8,7 @@ import Tests.Arbitrary()

8import Text.Pandoc.Builder

9import Text.Pandoc

10import Data.List (intersperse)

11−import Data.Monoid (mempty, mconcat)

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

13org :: String -> Pandoc

14org = readOrg def

@@ -98,6 +98,10 @@ tests =

98 "line \\\\ \nbreak" =?>

99 para ("line" <> linebreak <> "break")

100

101+ , "Inline note" =:

102+ "[fn::Schreib mir eine E-Mail]" =?>

103+ para (note $ para "Schreib mir eine E-Mail")

104+

101 , "Markup-chars not occuring on word break are symbols" =:

105 , "Markup-chars not occuring on word break are symbols" =:

102 unlines [ "this+that+ +so+on"

106 unlines [ "this+that+ +so+on"

103 , "seven*eight* nine*"

107 , "seven*eight* nine*"

@@ -359,29 +363,6 @@ tests =

359 , "#+END_COMMENT"] =?>

363 , "#+END_COMMENT"] =?>

360 (mempty::Blocks)

364 (mempty::Blocks)

361

365

362− , "Source Block in Text" =:

363− unlines [ "Low German greeting"

364− , " #+BEGIN_SRC haskell"

365− , " main = putStrLn greeting"

366− , " where greeting = \"moin\""

367− , " #+END_SRC" ] =?>

368− let attr' = ("", ["haskell"], [])

369− code' = "main = putStrLn greeting\n" ++

370− " where greeting = \"moin\"\n"

371− in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]

372− , codeBlockWith attr' code'

373− ]

374−

375− , "Source Block" =:

376− unlines [ " #+BEGIN_SRC haskell"

377− , " main = putStrLn greeting"

378− , " where greeting = \"moin\""

379− , " #+END_SRC" ] =?>

380− let attr' = ("", ["haskell"], [])

381− code' = "main = putStrLn greeting\n" ++

382− " where greeting = \"moin\"\n"

383− in codeBlockWith attr' code'

384−

385 , "Figure" =:

366 , "Figure" =:

386 unlines [ "#+caption: A very courageous man."

367 unlines [ "#+caption: A very courageous man."

387 , "#+name: goodguy"

368 , "#+name: goodguy"

@@ -402,6 +383,48 @@ tests =

402 ] =?>

383 ] =?>

403 para (image "the-red-queen.jpg" "fig:redqueen"

384 para (image "the-red-queen.jpg" "fig:redqueen"

404 "Used as a metapher in evolutionary biology.")

385 "Used as a metapher in evolutionary biology.")

386+

387+ , "Footnote" =:

388+ unlines [ "A footnote[1]"

389+ , ""

390+ , "[1] First paragraph"

391+ , ""

392+ , "second paragraph"

393+ ] =?>

394+ para (mconcat

395+ [ "A", space, "footnote"

396+ , note $ mconcat [ para ("First" <> space <> "paragraph")

397+ , para ("second" <> space <> "paragraph")

398+ ]

399+ ])

400+

401+ , "Two footnotes" =:

402+ unlines [ "Footnotes[fn:1][fn:2]"

403+ , ""

404+ , "[fn:1] First note."

405+ , ""

406+ , "[fn:2] Second note."

407+ ] =?>

408+ para (mconcat

409+ [ "Footnotes"

410+ , note $ para ("First" <> space <> "note.")

411+ , note $ para ("Second" <> space <> "note.")

412+ ])

413+

414+ , "Footnote followed by header" =:

415+ unlines [ "Another note[fn:yay]"

416+ , ""

417+ , "[fn:yay] This is great!"

418+ , ""

419+ , "** Headline"

420+ ] =?>

421+ mconcat

422+ [ para (mconcat

423+ [ "Another", space, "note"

424+ , note $ para ("This" <> space <> "is" <> space <> "great!")

425+ ])

426+ , header 2 "Headline"

427+ ]

405 ]

428 ]

406

429

407 , testGroup "Lists" $

430 , testGroup "Lists" $

@@ -537,13 +560,36 @@ tests =

537 , ("TTL", [ plain $ "transistor-transistor" <> space <>

560 , ("TTL", [ plain $ "transistor-transistor" <> space <>

538 "logic" ])

561 "logic" ])

539 , ("PSK", [ mconcat

562 , ("PSK", [ mconcat

540− [ para $ "phase-shift" <> space <> "keying"

563+ [ para $ "phase-shift" <> space <> "keying"

541− , plain $ spcSep [ "a", "digital"

564+ , para $ spcSep [ "a", "digital"

542− , "modulation", "scheme" ]

565+ , "modulation", "scheme" ]

543 ]

566 ]

544− ]

567+ ])

545− )

546 ]

568 ]

569+

570+ , "Compact definition list" =:

571+ unlines [ "- ATP :: adenosine 5' triphosphate"

572+ , "- DNA :: deoxyribonucleic acid"

573+ , "- PCR :: polymerase chain reaction"

574+ , ""

575+ ] =?>

576+ definitionList

577+ [ ("ATP", [ plain $ spcSep [ "adenosine", "5'", "triphosphate" ] ])

578+ , ("DNA", [ plain $ spcSep [ "deoxyribonucleic", "acid" ] ])

579+ , ("PCR", [ plain $ spcSep [ "polymerase", "chain", "reaction" ] ])

580+ ]

581+

582+ , "Loose bullet list" =:

583+ unlines [ "- apple"

584+ , ""

585+ , "- orange"

586+ , ""

587+ , "- peach"

588+ ] =?>

589+ bulletList [ para "apple"

590+ , para "orange"

591+ , para "peach"

592+ ]

547 ]

593 ]

548

594

549 , testGroup "Tables"

595 , testGroup "Tables"

@@ -656,5 +702,126 @@ tests =

656 [ [ plain "1" , plain "One" , plain "foo" ]

702 [ [ plain "1" , plain "One" , plain "foo" ]

657 , [ plain "2" , plain mempty , plain mempty ]

703 , [ plain "2" , plain mempty , plain mempty ]

658 ]

704 ]

705+

706+ , "Table with caption" =:

707+ unlines [ "#+CAPTION: Hitchhiker's Multiplication Table"

708+ , "| x | 6 |"

709+ , "| 9 | 42 |"

710+ ] =?>

711+ table "Hitchhiker's Multiplication Table"

712+ [(AlignDefault, 0), (AlignDefault, 0)]

713+ []

714+ [ [ plain "x", plain "6" ]

715+ , [ plain "9", plain "42" ]

716+ ]

717+ ]

718+

719+ , testGroup "Blocks and fragments"

720+ [ "Source block" =:

721+ unlines [ " #+BEGIN_SRC haskell"

722+ , " main = putStrLn greeting"

723+ , " where greeting = \"moin\""

724+ , " #+END_SRC" ] =?>

725+ let attr' = ("", ["haskell"], [])

726+ code' = "main = putStrLn greeting\n" ++

727+ " where greeting = \"moin\"\n"

728+ in codeBlockWith attr' code'

729+

730+ , "Source block between paragraphs" =:

731+ unlines [ "Low German greeting"

732+ , " #+BEGIN_SRC haskell"

733+ , " main = putStrLn greeting"

734+ , " where greeting = \"Moin!\""

735+ , " #+END_SRC" ] =?>

736+ let attr' = ("", ["haskell"], [])

737+ code' = "main = putStrLn greeting\n" ++

738+ " where greeting = \"Moin!\"\n"

739+ in mconcat [ para $ spcSep [ "Low", "German", "greeting" ]

740+ , codeBlockWith attr' code'

741+ ]

742+

743+ , "Example block" =:

744+ unlines [ "#+begin_example"

745+ , "A chosen representation of"

746+ , "a rule."

747+ , "#+eND_exAMPle"

748+ ] =?>

749+ codeBlockWith ("", ["example"], [])

750+ "A chosen representation of\na rule.\n"

751+

752+ , "HTML block" =:

753+ unlines [ "#+BEGIN_HTML"

754+ , "<aside>HTML5 is pretty nice.</aside>"

755+ , "#+END_HTML"

756+ ] =?>

757+ rawBlock "html" "<aside>HTML5 is pretty nice.</aside>\n"

758+

759+ , "Quote block" =:

760+ unlines [ "#+BEGIN_QUOTE"

761+ , "/Niemand/ hat die Absicht, eine Mauer zu errichten!"

762+ , "#+END_QUOTE"

763+ ] =?>

764+ blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht,"

765+ , "eine", "Mauer", "zu", "errichten!"

766+ ]))

767+

768+ , "Verse block" =:

769+ unlines [ "The first lines of Goethe's /Faust/:"

770+ , "#+begin_verse"

771+ , "Habe nun, ach! Philosophie,"

772+ , "Juristerei und Medizin,"

773+ , "Und leider auch Theologie!"

774+ , "Durchaus studiert, mit heißem Bemühn."

775+ , "#+end_verse"

776+ ] =?>

777+ mconcat

778+ [ para $ spcSep [ "The", "first", "lines", "of"

779+ , "Goethe's", emph "Faust" <> ":"]

780+ , para $ mconcat

781+ [ spcSep [ "Habe", "nun,", "ach!", "Philosophie," ]

782+ , linebreak

783+ , spcSep [ "Juristerei", "und", "Medizin," ]

784+ , linebreak

785+ , spcSep [ "Und", "leider", "auch", "Theologie!" ]

786+ , linebreak

787+ , spcSep [ "Durchaus", "studiert,", "mit", "heißem", "Bemühn." ]

788+ ]

789+ ]

790+

791+ , "LaTeX fragment" =:

792+ unlines [ "\\begin{equation}"

793+ , "X_i = \\begin{cases}"

794+ , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) = \\alpha(i)\\\\"

795+ , " C_{\\alpha(i)} & \\text{otherwise}"

796+ , " \\end{cases}"

797+ , "\\end{equation}"

798+ ] =?>

799+ rawBlock "latex"

800+ (unlines [ "\\begin{equation}"

801+ , "X_i = \\begin{cases}"

802+ , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) =" ++

803+ " \\alpha(i)\\\\"

804+ , " C_{\\alpha(i)} & \\text{otherwise}"

805+ , " \\end{cases}"

806+ , "\\end{equation}"

807+ ])

808+

809+ , "Code block with caption" =:

810+ unlines [ "#+CAPTION: Functor laws in Haskell"

811+ , "#+NAME: functor-laws"

812+ , "#+BEGIN_SRC haskell"

813+ , "fmap id = id"

814+ , "fmap (p . q) = (fmap p) . (fmap q)"

815+ , "#+END_SRC"

816+ ] =?>

817+ divWith

818+ nullAttr

819+ (mappend

820+ (plain $ spanWith ("", ["label"], [])

821+ (spcSep [ "Functor", "laws", "in", "Haskell" ]))

822+ (codeBlockWith ("functor-laws", ["haskell"], [])

823+ (unlines [ "fmap id = id"

824+ , "fmap (p . q) = (fmap p) . (fmap q)"

825+ ])))

659 ]

826 ]

660 ]

827 ]