b1e6ea8 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1179 from tarleb/org

b1e6ea8John MacFarlane13 years ago

README+17−16

compare with master

unifiedsplit

@@ -13,14 +13,15 @@ Description

13Pandoc is a [Haskell] library for converting from one markup format to

14another, and a command-line tool that uses this library. It can read

15[markdown] and (subsets of) [Textile], [reStructuredText], [HTML],

16−[LaTeX], [MediaWiki markup], [Haddock markup], [OPML], and [DocBook]; and

16+[LaTeX], [MediaWiki markup], [Haddock markup], [OPML], [Emacs Org-mode]

17−it can write plain text, [markdown], [reStructuredText], [XHTML], [HTML 5],

17+and [DocBook]; and it can write plain text, [markdown],

18+[reStructuredText], [XHTML], [HTML 5], [LaTeX] (including [beamer] slide

18−[LaTeX] (including [beamer] slide shows), [ConTeXt], [RTF], [OPML], [DocBook],

19+shows), [ConTeXt], [RTF], [OPML], [DocBook], [OpenDocument], [ODT],

19−[OpenDocument], [ODT], [Word docx], [GNU Texinfo], [MediaWiki markup],

20+[Word docx], [GNU Texinfo], [MediaWiki markup], [EPUB] (v2 or v3),

20−[EPUB] (v2 or v3), [FictionBook2], [Textile], [groff man] pages, [Emacs

21+[FictionBook2], [Textile], [groff man] pages, [Emacs Org-Mode],

21−Org-Mode], [AsciiDoc], and [Slidy], [Slideous], [DZSlides], [reveal.js]

22+[AsciiDoc], and [Slidy], [Slideous], [DZSlides], [reveal.js] or [S5]

22−or [S5] HTML slide shows. It can also produce [PDF] output on systems

23+HTML slide shows. It can also produce [PDF] output on systems where

23−where LaTeX is installed.

24+LaTeX is installed.

25Pandoc's enhanced version of markdown includes syntax for footnotes,

26Pandoc's enhanced version of markdown includes syntax for footnotes,

26tables, flexible ordered lists, definition lists, fenced code blocks,

27tables, flexible ordered lists, definition lists, fenced code blocks,

@@ -143,14 +144,14 @@ General options

143 `markdown_phpextra` (PHP Markdown Extra extended markdown),

144 `markdown_phpextra` (PHP Markdown Extra extended markdown),

144 `markdown_github` (github extended markdown),

145 `markdown_github` (github extended markdown),

145 `textile` (Textile), `rst` (reStructuredText), `html` (HTML),

146 `textile` (Textile), `rst` (reStructuredText), `html` (HTML),

146− `docbook` (DocBook), `opml` (OPML), `mediawiki` (MediaWiki markup),

147+ `docbook` (DocBook), `opml` (OPML), `org` (Emacs Org-mode),

147− `haddock` (Haddock markup), or `latex` (LaTeX).

148+ `mediawiki` (MediaWiki markup), `haddock` (Haddock markup), or

148− If `+lhs` is appended to `markdown`, `rst`, `latex`, or `html`,

149+ latex` (LaTeX). If `+lhs` is appended to `markdown`, `rst`,

149− the input will be treated as literate Haskell source:

150+ `latex`, or `html`, the input will be treated as literate Haskell

150− see [Literate Haskell support](#literate-haskell-support), below.

151+ source: see [Literate Haskell support](#literate-haskell-support),

151− Markdown syntax extensions can be individually enabled or disabled

152+ below. Markdown syntax extensions can be individually enabled or

152− by appending `+EXTENSION` or `-EXTENSION` to the format name.

153+ disabled by appending `+EXTENSION` or `-EXTENSION` to the format

153− So, for example, `markdown_strict+footnotes+definition_lists`

154+ name. So, for example, `markdown_strict+footnotes+definition_lists`

154 is strict markdown with footnotes and definition lists enabled,

155 is strict markdown with footnotes and definition lists enabled,

155 and `markdown-pipe_tables+hard_line_breaks` is pandoc's markdown

156 and `markdown-pipe_tables+hard_line_breaks` is pandoc's markdown

156 without pipe tables and with hard line breaks. See [Pandoc's

157 without pipe tables and with hard line breaks. See [Pandoc's

pandoc.cabal+2

@@ -263,6 +263,7 @@ Library

263 Text.Pandoc.Readers.Markdown,

264 Text.Pandoc.Readers.MediaWiki,

265 Text.Pandoc.Readers.RST,

266+ Text.Pandoc.Readers.Org,

266 Text.Pandoc.Readers.DocBook,

267 Text.Pandoc.Readers.DocBook,

267 Text.Pandoc.Readers.OPML,

268 Text.Pandoc.Readers.OPML,

268 Text.Pandoc.Readers.TeXMath,

269 Text.Pandoc.Readers.TeXMath,

@@ -381,6 +382,7 @@ Test-Suite test-pandoc

381 Tests.Walk

382 Tests.Walk

382 Tests.Readers.LaTeX

383 Tests.Readers.LaTeX

383 Tests.Readers.Markdown

384 Tests.Readers.Markdown

385+ Tests.Readers.Org

384 Tests.Readers.RST

386 Tests.Readers.RST

385 Tests.Writers.Native

387 Tests.Writers.Native

386 Tests.Writers.ConTeXt

388 Tests.Writers.ConTeXt

pandoc.hs+1

@@ -834,6 +834,7 @@ defaultReaderName fallback (x:xs) =

834 ".latex" -> "latex"

835 ".ltx" -> "latex"

836 ".rst" -> "rst"

837+ ".org" -> "org"

837 ".lhs" -> "markdown+lhs"

838 ".lhs" -> "markdown+lhs"

838 ".db" -> "docbook"

839 ".db" -> "docbook"

839 ".opml" -> "opml"

840 ".opml" -> "opml"

src/Text/Pandoc.hs+3

@@ -65,6 +65,7 @@ module Text.Pandoc

65 , readMarkdown

66 , readMediaWiki

67 , readRST

68+ , readOrg

68 , readLaTeX

69 , readLaTeX

69 , readHtml

70 , readHtml

70 , readTextile

71 , readTextile

@@ -115,6 +116,7 @@ import Text.Pandoc.JSON

115import Text.Pandoc.Readers.Markdown

116import Text.Pandoc.Readers.Markdown

116import Text.Pandoc.Readers.MediaWiki

117import Text.Pandoc.Readers.MediaWiki

117import Text.Pandoc.Readers.RST

118import Text.Pandoc.Readers.RST

119+import Text.Pandoc.Readers.Org

118import Text.Pandoc.Readers.DocBook

120import Text.Pandoc.Readers.DocBook

119import Text.Pandoc.Readers.OPML

121import Text.Pandoc.Readers.OPML

120import Text.Pandoc.Readers.LaTeX

122import Text.Pandoc.Readers.LaTeX

@@ -201,6 +203,7 @@ readers = [ ("native" , \_ s -> return $ readNative s)

201 ,("mediawiki" , \o s -> return $ readMediaWiki o s)

203 ,("mediawiki" , \o s -> return $ readMediaWiki o s)

202 ,("docbook" , \o s -> return $ readDocBook o s)

204 ,("docbook" , \o s -> return $ readDocBook o s)

203 ,("opml" , \o s -> return $ readOPML o s)

205 ,("opml" , \o s -> return $ readOPML o s)

206+ ,("org" , \o s -> return $ readOrg o s)

204 ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs

207 ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs

205 ,("html" , \o s -> return $ readHtml o s)

208 ,("html" , \o s -> return $ readHtml o s)

206 ,("latex" , \o s -> return $ readLaTeX o s)

209 ,("latex" , \o s -> return $ readLaTeX o s)

src/Text/Pandoc/Readers/Org.hsnew file+552

@@ -0,0 +1,552 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-

5+This program is free software; you can redistribute it and/or modify

6+it under the terms of the GNU General Public License as published by

7+the Free Software Foundation; either version 2 of the License, or

8+(at your option) any later version.

10+This program is distributed in the hope that it will be useful,

11+but WITHOUT ANY WARRANTY; without even the implied warranty of

12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13+GNU General Public License for more details.

14+

15+You should have received a copy of the GNU General Public License

16+along with this program; if not, write to the Free Software

17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18+-}

19+

20+{- |

21+ Module : Text.Pandoc.Readers.Org

23+ License : GNU GPL, version 2 or above

24+

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

26+

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

28+-}

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

30+

31+import qualified Text.Pandoc.Builder as B

32+import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))

33+import Text.Pandoc.Definition

34+import Text.Pandoc.Options

35+import Text.Pandoc.Parsing hiding (orderedListMarker)

36+import Text.Pandoc.Shared (compactify')

37+

38+import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))

39+import Control.Monad (guard, mzero)

40+import Data.Char (toLower)

41+import Data.List (foldl')

42+import Data.Maybe (listToMaybe, fromMaybe)

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

44+

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

46+readOrg :: ReaderOptions -- ^ Reader options

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

48+ -> Pandoc

49+readOrg opts s = (readWith parseOrg) def{ stateOptions = opts } (s ++ "\n\n")

50+

51+type OrgParser = Parser [Char] ParserState

52+

53+parseOrg:: OrgParser Pandoc

54+parseOrg = do

55+ blocks' <- B.toList <$> parseBlocks

56+ st <- getState

57+ let meta = stateMeta st

58+ return $ Pandoc meta $ filter (/= Null) blocks'

59+

60+--

61+-- parsing blocks

62+--

63+

64+parseBlocks :: OrgParser Blocks

65+parseBlocks = mconcat <$> manyTill block eof

66+

67+block :: OrgParser Blocks

68+block = choice [ mempty <$ blanklines

69+ , orgBlock

70+ , example

71+ , drawer

72+ , specialLine

73+ , header

74+ , hline

75+ , list

76+ , table

77+ , paraOrPlain

78+ ] <?> "block"

79+

80+--

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

82+--

83+

84+orgBlock :: OrgParser Blocks

85+orgBlock = try $ do

86+ (indent, blockType, args) <- blockHeader

87+ blockStr <- rawBlockContent indent blockType

88+ let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]

89+ case blockType of

90+ "comment" -> return mempty

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

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

93+ <$> (parseFromString parseBlocks blockStr)

94+

95+blockHeader :: OrgParser (Int, String, [String])

96+blockHeader = (,,) <$> blockIndent

97+ <*> blockType

98+ <*> (skipSpaces *> blockArgs)

99+ where blockIndent = length <$> many spaceChar

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

101+ blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline

102+

103+rawBlockContent :: Int -> String -> OrgParser String

104+rawBlockContent indent blockType =

105+ unlines . map commaEscaped <$> manyTill indentedLine blockEnder

106+ where

107+ indentedLine = try $ choice [ blankline *> pure "\n"

108+ , indentWith indent *> anyLine

109+ ]

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

111+

112+-- indent by specified number of spaces (or equiv. tabs)

113+indentWith :: Int -> OrgParser String

114+indentWith num = do

115+ tabStop <- getOption readerTabStop

116+ if (num < tabStop)

117+ then count num (char ' ')

118+ else choice [ try (count num (char ' '))

119+ , try (char '\t' >> count (num - tabStop) (char ' ')) ]

120+

121+translateLang :: String -> String

122+translateLang "sh" = "bash"

123+translateLang cs = cs

124+

125+commaEscaped :: String -> String

126+commaEscaped (',':cs@('*':_)) = cs

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

128+commaEscaped cs = cs

129+

130+example :: OrgParser Blocks

131+example = try $

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

133+

134+exampleLine :: OrgParser String

135+exampleLine = try $ string ": " *> anyLine

136+

137+-- Drawers for properties or a logbook

138+drawer :: OrgParser Blocks

139+drawer = try $ do

140+ drawerStart

141+ manyTill drawerLine (try drawerEnd)

142+ return mempty

143+

144+drawerStart :: OrgParser String

145+drawerStart = try $

146+ skipSpaces *> drawerName <* skipSpaces <* newline

147+ where drawerName = try $ char ':' *> validDrawerName <* char ':'

148+ validDrawerName = stringAnyCase "PROPERTIES"

149+ <|> stringAnyCase "LOGBOOK"

150+

151+drawerLine :: OrgParser String

152+drawerLine = try $ anyLine

153+

154+drawerEnd :: OrgParser String

155+drawerEnd = try $

156+ skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline

157+

158+

159+-- Comments, Options and Metadata

160+specialLine :: OrgParser Blocks

161+specialLine = try $ metaLine <|> commentLine

162+

163+metaLine :: OrgParser Blocks

164+metaLine = try $ metaLineStart *> declarationLine

165+

166+commentLine :: OrgParser Blocks

167+commentLine = try $ commentLineStart *> anyLine *> pure mempty

168+

169+-- The order, in which blocks are tried, makes sure that we're not looking at

170+-- the beginning of a block, so we don't need to check for it

171+metaLineStart :: OrgParser String

172+metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"

173+

174+commentLineStart :: OrgParser String

175+commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

176+

177+declarationLine :: OrgParser Blocks

178+declarationLine = try $ do

179+ meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta

180+ updateState $ \st -> st { stateMeta = stateMeta st <> meta' }

181+ return mempty

182+

183+metaValue :: OrgParser MetaValue

184+metaValue = MetaInlines . B.toList . trimInlines <$> restOfLine

185+

186+metaKey :: OrgParser [Char]

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

188+ <* char ':'

189+ <* skipSpaces

190+

191+-- | Headers

192+header :: OrgParser Blocks

193+header = try $

194+ B.header <$> headerStart

195+ <*> (trimInlines <$> restOfLine)

196+

197+headerStart :: OrgParser Int

198+headerStart = try $

199+ (length <$> many1 (char '*')) <* many1 (char ' ')

200+

201+-- Horizontal Line (five dashes or more)

202+hline :: OrgParser Blocks

203+hline = try $ do

204+ skipSpaces

205+ string "-----"

206+ many (char '-')

207+ skipSpaces

208+ newline

209+ return B.horizontalRule

210+

211+--

212+-- Tables

213+--

214+

215+data OrgTableRow = OrgContentRow [Blocks]

216+ | OrgAlignRow [Alignment]

217+ | OrgHlineRow

218+ deriving (Eq, Show)

219+

220+type OrgTableContent = (Int, [Alignment], [Double], [Blocks], [[Blocks]])

221+

222+table :: OrgParser Blocks

223+table = try $ do

224+ lookAhead tableStart

225+ (_, aligns, widths, heads, lns) <- normalizeTable . tableContent <$> tableRows

226+ return $ B.table "" (zip aligns widths) heads lns

227+

228+tableStart :: OrgParser Char

229+tableStart = try $ skipSpaces *> char '|'

230+

231+tableRows :: OrgParser [OrgTableRow]

232+tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

233+

234+tableContentRow :: OrgParser OrgTableRow

235+tableContentRow = try $

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

237+

238+tableContentCell :: OrgParser Blocks

239+tableContentCell = try $

240+ B.plain . trimInlines . mconcat <$> many1Till inline (try endOfCell)

241+

242+endOfCell :: OrgParser Char

243+-- endOfCell = char '|' <|> newline

244+endOfCell = try $ char '|' <|> lookAhead newline

245+

246+tableAlignRow :: OrgParser OrgTableRow

247+tableAlignRow = try $

248+ OrgAlignRow <$> (tableStart *> manyTill tableAlignCell newline)

249+

250+tableAlignCell :: OrgParser Alignment

251+tableAlignCell =

252+ choice [ try $ emptyCell *> return (AlignDefault)

253+ , try $ skipSpaces

254+ *> char '<'

255+ *> tableAlignFromChar

256+ <* many digit

257+ <* char '>'

258+ <* emptyCell

259+ ] <?> "alignment info"

260+ where emptyCell = try $ skipSpaces *> endOfCell

261+

262+tableAlignFromChar :: OrgParser Alignment

263+tableAlignFromChar = try $ choice [ char 'l' *> return AlignLeft

264+ , char 'c' *> return AlignCenter

265+ , char 'r' *> return AlignRight

266+ ]

267+

268+tableHline :: OrgParser OrgTableRow

269+tableHline = try $

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

271+

272+tableContent :: [OrgTableRow]

273+ -> OrgTableContent

274+tableContent = foldl' (flip rowToContent) (0, mempty, repeat 0, mempty, mempty)

275+

276+normalizeTable :: OrgTableContent

277+ -> OrgTableContent

278+normalizeTable (cols, aligns, widths, heads, lns) =

279+ let aligns' = fillColumns aligns AlignDefault

280+ widths' = fillColumns widths 0.0

281+ heads' = if heads == mempty

282+ then heads

283+ else fillColumns heads (B.plain mempty)

284+ lns' = map (flip fillColumns (B.plain mempty)) lns

285+ fillColumns base padding = take cols $ base ++ repeat padding

286+ in (cols, aligns', widths', heads', lns')

287+

288+

289+-- One or more horizontal rules after the first content line mark the previous

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

291+rowToContent :: OrgTableRow

292+ -> OrgTableContent

293+ -> OrgTableContent

294+rowToContent OrgHlineRow = maybeBodyToHeader

295+rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs

296+rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as

297+

298+setLongestRow :: [a]

299+ -> OrgTableContent

300+ -> OrgTableContent

301+setLongestRow r (cols, aligns, widths, heads, lns) =

302+ (max cols (length r), aligns, widths, heads, lns)

303+

304+maybeBodyToHeader :: OrgTableContent

305+ -> OrgTableContent

306+maybeBodyToHeader (cols, aligns, widths, [], b:[]) = (cols, aligns, widths, b, [])

307+maybeBodyToHeader content = content

308+

309+appendToBody :: [Blocks]

310+ -> OrgTableContent

311+ -> OrgTableContent

312+appendToBody r (cols, aligns, widths, heads, lns) =

313+ (cols, aligns, widths, heads, lns ++ [r])

314+

315+setAligns :: [Alignment]

316+ -> OrgTableContent

317+ -> OrgTableContent

318+setAligns aligns (cols, _, widths, heads, lns) =

319+ (cols, aligns, widths, heads, lns)

320+

321+-- Paragraphs or Plain text

322+paraOrPlain :: OrgParser Blocks

323+paraOrPlain = try $

324+ trimInlines . mconcat

325+ <$> many1 inline

326+ <**> option B.plain

327+ (try $ newline *> pure B.para)

328+

329+restOfLine :: OrgParser Inlines

330+restOfLine = mconcat <$> manyTill inline newline

331+

332+

333+--

334+-- list blocks

335+--

336+

337+list :: OrgParser Blocks

338+list = choice [ bulletList, orderedList ] <?> "list"

339+

340+bulletList :: OrgParser Blocks

341+bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)

342+

343+orderedList :: OrgParser Blocks

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

345+

346+genericListStart :: OrgParser String

347+ -> OrgParser Int

348+genericListStart listMarker = try $

349+ (+) <$> (length <$> many spaceChar)

350+ <*> (length <$> listMarker <* many1 spaceChar)

351+

352+-- parses bullet list start and returns its length (excl. following whitespace)

353+bulletListStart :: OrgParser Int

354+bulletListStart = genericListStart bulletListMarker

355+ where bulletListMarker = pure <$> oneOf "*-+"

356+

357+orderedListStart :: OrgParser Int

358+orderedListStart = genericListStart orderedListMarker

359+ -- Ordered list markers allowed in org-mode

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

361+

362+listItem :: OrgParser Int

363+ -> OrgParser Blocks

364+listItem start = try $ do

365+ (markerLength, first) <- try (start >>= rawListItem)

366+ rest <- many (listContinuation markerLength)

367+ parseFromString parseBlocks $ concat (first:rest)

368+

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

370+rawListItem :: Int

371+ -> OrgParser (Int, String)

372+rawListItem markerLength = try $ do

373+ firstLine <- anyLine

374+ restLines <- many (listLine markerLength)

375+ return (markerLength, (firstLine ++ "\n" ++ (concat restLines)))

376+

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

378+-- Note: nested lists are parsed as continuations.

379+listContinuation :: Int

380+ -> OrgParser String

381+listContinuation markerLength = try $

382+ mappend <$> many blankline

383+ <*> (concat <$> many1 (listLine markerLength))

384+

385+-- parse a line of a list item

386+listLine :: Int

387+ -> OrgParser String

388+listLine markerLength = try $

389+ indentWith markerLength *> anyLine

390+ <**> pure (++ "\n")

391+

392+

393+--

394+-- inline

395+--

396+

397+inline :: OrgParser Inlines

398+inline = choice inlineParsers <?> "inline"

399+ where inlineParsers = [ whitespace

400+ , link

401+ , str

402+ , endline

403+ , emph

404+ , strong

405+ , strikeout

406+ , underline

407+ , code

408+ , verbatim

409+ , subscript

410+ , superscript

411+ , symbol

412+ ]

413+

414+-- treat these as potentially non-text when parsing inline:

415+specialChars :: [Char]

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

417+

418+

419+whitespace :: OrgParser Inlines

420+whitespace = B.space <$ skipMany1 spaceChar <?> "whitespace"

421+

422+str :: OrgParser Inlines

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

424+ <* updateLastStrPos

425+

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

427+endline :: OrgParser Inlines

428+endline = try $ do

429+ newline

430+ notFollowedBy blankline

431+ notFollowedBy' exampleLine

432+ notFollowedBy' hline

433+ notFollowedBy' tableStart

434+ notFollowedBy' drawerStart

435+ notFollowedBy' headerStart

436+ notFollowedBy' metaLineStart

437+ notFollowedBy' commentLineStart

438+ notFollowedBy' bulletListStart

439+ notFollowedBy' orderedListStart

440+ return B.space

441+

442+link :: OrgParser Inlines

443+link = explicitLink <|> selfLink <?> "link"

444+

445+explicitLink :: OrgParser Inlines

446+explicitLink = try $ do

447+ char '['

448+ src <- enclosedRaw (char '[') (char ']')

449+ title <- enclosedInlines (char '[') (char ']')

450+ char ']'

451+ return $ B.link src "" title

452+

453+selfLink :: OrgParser Inlines

454+selfLink = try $ do

455+ src <- enclosedRaw (string "[[") (string "]]")

456+ return $ B.link src "" (B.str src)

457+

458+emph :: OrgParser Inlines

459+emph = B.emph <$> inlinesEnclosedBy '/'

460+

461+strong :: OrgParser Inlines

462+strong = B.strong <$> inlinesEnclosedBy '*'

463+

464+strikeout :: OrgParser Inlines

465+strikeout = B.strikeout <$> inlinesEnclosedBy '+'

466+

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

468+underline :: OrgParser Inlines

469+underline = B.strong <$> inlinesEnclosedBy '_'

470+

471+code :: OrgParser Inlines

472+code = B.code <$> rawEnclosedBy '='

473+

474+verbatim :: OrgParser Inlines

475+verbatim = B.rawInline "" <$> rawEnclosedBy '~'

476+

477+subscript :: OrgParser Inlines

478+subscript = B.subscript <$> (try $ char '_' *> maybeGroupedByBraces)

479+

480+superscript :: OrgParser Inlines

481+superscript = B.superscript <$> (try $ char '^' *> maybeGroupedByBraces)

482+

483+maybeGroupedByBraces :: OrgParser Inlines

484+maybeGroupedByBraces = try $

485+ choice [ try $ enclosedInlines (char '{') (char '}')

486+ , B.str . (:"") <$> anyChar

487+ ]

488+

489+symbol :: OrgParser Inlines

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

491+

492+enclosedInlines :: OrgParser a

493+ -> OrgParser b

494+ -> OrgParser Inlines

495+enclosedInlines start end = try $

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

497+

498+-- FIXME: This is a hack

499+inlinesEnclosedBy :: Char

500+ -> OrgParser Inlines

501+inlinesEnclosedBy c = enclosedInlines (atStart (char c) <* endsOnThisOrNextLine c)

502+ (atEnd $ char c)

503+

504+enclosedRaw :: OrgParser a

505+ -> OrgParser b

506+ -> OrgParser String

507+enclosedRaw start end = try $

508+ start *> (onSingleLine <|> spanningTwoLines)

509+ where onSingleLine = try $ many1Till (noneOf "\n\r") end

510+ spanningTwoLines = try $

511+ anyLine >>= \f -> mappend (f <> " ") <$> onSingleLine

512+

513+rawEnclosedBy :: Char

514+ -> OrgParser String

515+rawEnclosedBy c = enclosedRaw (atStart $ char c) (atEnd $ char c)

516+

517+-- succeeds only if we're not right after a str (ie. in middle of word)

518+atStart :: OrgParser a -> OrgParser a

519+atStart p = do

520+ pos <- getPosition

521+ st <- getState

522+ guard $ stateLastStrPos st /= Just pos

523+ p

524+

525+-- | succeeds only if we're at the end of a word

526+atEnd :: OrgParser a -> OrgParser a

527+atEnd p = try $ p <* lookingAtEndOfWord

528+ where lookingAtEndOfWord = lookAhead . oneOf $ postWordChars

529+

530+postWordChars :: [Char]

531+postWordChars = "\t\n\r !\"'),-.:?}"

532+

533+-- FIXME: These functions are hacks and should be replaced

534+endsOnThisOrNextLine :: Char

535+ -> OrgParser ()

536+endsOnThisOrNextLine c = do

537+ inp <- getInput

538+ let doOtherwise = \rest -> endsOnThisLine rest c (const mzero)

539+ endsOnThisLine inp c doOtherwise

540+

541+endsOnThisLine :: [Char]

542+ -> Char

543+ -> ([Char] -> OrgParser ())

544+ -> OrgParser ()

545+endsOnThisLine input c doOnOtherLines = do

546+ case break (`elem` c:"\n") input of

547+ (_,'\n':rest) -> doOnOtherLines rest

548+ (_,_:rest@(n:_)) -> if n `elem` postWordChars

549+ then return ()

550+ else endsOnThisLine rest c doOnOtherLines

551+ _ -> mzero

552+

tests/Tests/Readers/Org.hsnew file+533

@@ -0,0 +1,533 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Tests.Readers.Org (tests) where

4+import Text.Pandoc.Definition

5+import Test.Framework

6+import Tests.Helpers

7+import Tests.Arbitrary()

8+import Text.Pandoc.Builder

9+import Text.Pandoc

10+import Data.List (intersperse)

11+import Data.Monoid (mempty, mconcat)

12+

13+org :: String -> Pandoc

14+org = readOrg def

15+

16+infix 4 =:

17+(=:) :: ToString c

18+ => String -> (String, c) -> Test

19+(=:) = test org

20+

21+spcSep :: [Inlines] -> Inlines

22+spcSep = mconcat . intersperse space

23+

24+simpleTable' :: Int

25+ -> [Blocks]

26+ -> [[Blocks]]

27+ -> Blocks

28+simpleTable' n = table "" (take n $ repeat (AlignDefault, 0.0))

29+

30+tests :: [Test]

31+tests =

32+ [ testGroup "Inlines" $

33+ [ "Plain String" =:

34+ "Hello, World" =?>

35+ para (spcSep [ "Hello,", "World" ])

36+

37+ , "Emphasis" =:

38+ "/Planet Punk/" =?>

39+ para (emph . spcSep $ ["Planet", "Punk"])

40+

41+ , "Strong" =:

42+ "*Cider*" =?>

43+ para (strong "Cider")

44+

45+ , "Strikeout" =:

46+ "+Kill Bill+" =?>

47+ para (strikeout . spcSep $ [ "Kill", "Bill" ])

48+

49+ , "Code" =:

50+ "=Robot.rock()=" =?>

51+ para (code "Robot.rock()")

52+

53+ , "Verbatim" =:

54+ "~word for word~" =?>

55+ para (rawInline "" "word for word")

56+

57+ , "Symbol" =:

58+ "A * symbol" =?>

59+ para (str "A" <> space <> str "*" <> space <> "symbol")

60+

61+ , "Superscript single char" =:

62+ "2^n" =?>

63+ para (str "2" <> superscript "n")

64+

65+ , "Superscript multi char" =:

66+ "2^{n-1}" =?>

67+ para (str "2" <> superscript "n-1")

68+

69+ , "Subscript single char" =:

70+ "a_n" =?>

71+ para (str "a" <> subscript "n")

72+

73+ , "Subscript multi char" =:

74+ "a_{n+1}" =?>

75+ para (str "a" <> subscript "n+1")

76+

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

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

79+ , "seven*eight* nine*"

80+ , "+not+funny+"

81+ ] =?>

82+ para (spcSep [ "this+that+", "+so+on"

83+ , "seven*eight*", "nine*"

84+ , strikeout "not+funny"

85+ ])

86+

87+ , "Markup may not span more than two lines" =:

88+ unlines [ "/this *is", "not*", "emph/" ] =?>

89+ para (spcSep [ "/this"

90+ , (strong ("is" <> space <> "not"))

91+ , "emph/" ])

92+

93+ , "Explicit link" =:

94+ "[[http://zeitlens.com/][pseudo-random nonsense]]" =?>

95+ (para $ link "http://zeitlens.com/" ""

96+ ("pseudo-random" <> space <> "nonsense"))

97+

98+ , "Self-link" =:

99+ "[[http://zeitlens.com/]]" =?>

100+ (para $ link "http://zeitlens.com/" "" "http://zeitlens.com/")

101+ ]

102+

103+ , testGroup "Meta Information" $

104+ [ "Comment" =:

105+ "# Nothing to see here" =?>

106+ (mempty::Blocks)

107+

108+ , "Not a comment" =:

109+ "#-tag" =?>

110+ para "#-tag"

111+

112+ , "Comment surrounded by Text" =:

113+ unlines [ "Before"

114+ , "# Comment"

115+ , "After"

116+ ] =?>

117+ mconcat [ para "Before"

118+ , para "After"

119+ ]

120+

121+ , "Title" =:

122+ "#+TITLE: Hello, World" =?>

123+ let titleInline = toList $ "Hello," <> space <> "World"

124+ meta = setMeta "title" (MetaInlines titleInline) $ nullMeta

125+ in Pandoc meta mempty

126+

127+ , "Author" =:

128+ "#+author: Albert /Emacs-Fanboy/ Krewinkel" =?>

129+ let author = toList . spcSep $ [ "Albert", emph "Emacs-Fanboy", "Krewinkel" ]

130+ meta = setMeta "author" (MetaInlines author) $ nullMeta

131+ in Pandoc meta mempty

132+

133+ , "Date" =:

134+ "#+Date: Feb. *28*, 2014" =?>

135+ let date = toList . spcSep $ [ "Feb.", (strong "28") <> ",", "2014" ]

136+ meta = setMeta "date" (MetaInlines date) $ nullMeta

137+ in Pandoc meta mempty

138+

139+ , "Description" =:

140+ "#+DESCRIPTION: Explanatory text" =?>

141+ let description = toList . spcSep $ [ "Explanatory", "text" ]

142+ meta = setMeta "description" (MetaInlines description) $ nullMeta

143+ in Pandoc meta mempty

144+

145+ , "Properties drawer" =:

146+ unlines [ " :PROPERTIES:"

147+ , " :setting: foo"

148+ , " :END:"

149+ ] =?>

150+ (mempty::Blocks)

151+

152+ , "Logbook drawer" =:

153+ unlines [ " :LogBook:"

154+ , " - State \"DONE\" from \"TODO\" [2014-03-03 Mon 11:00]"

155+ , " :END:"

156+ ] =?>

157+ (mempty::Blocks)

158+

159+ , "Drawer surrounded by text" =:

160+ unlines [ "Before"

161+ , ":PROPERTIES:"

162+ , ":END:"

163+ , "After"

164+ ] =?>

165+ para "Before" <> para "After"

166+

167+ , "Drawer start is the only text in first line of a drawer" =:

168+ unlines [ " :LOGBOOK: foo"

169+ , " :END:"

170+ ] =?>

171+ para (spcSep [ ":LOGBOOK:", "foo", ":END:" ])

172+

173+ , "Drawers with unknown names are just text" =:

174+ unlines [ ":FOO:"

175+ , ":END:"

176+ ] =?>

177+ para (":FOO:" <> space <> ":END:")

178+ ]

179+

180+ , testGroup "Basic Blocks" $

181+ [ "Paragraph" =:

182+ "Paragraph\n" =?>

183+ para "Paragraph"

184+

185+ , "First Level Header" =:

186+ "* Headline\n" =?>

187+ header 1 "Headline"

188+

189+ , "Third Level Header" =:

190+ "*** Third Level Headline\n" =?>

191+ header 3 ("Third" <> space <>

192+ "Level" <> space <>

193+ "Headline")

194+

195+ , "Compact Headers with Paragraph" =:

196+ unlines [ "* First Level"

197+ , "** Second Level"

198+ , " Text"

199+ ] =?>

200+ mconcat [ header 1 ("First" <> space <> "Level")

201+ , header 2 ("Second" <> space <> "Level")

202+ , para "Text"

203+ ]

204+

205+ , "Separated Headers with Paragraph" =:

206+ unlines [ "* First Level"

207+ , ""

208+ , "** Second Level"

209+ , ""

210+ , " Text"

211+ ] =?>

212+ mconcat [ header 1 ("First" <> space <> "Level")

213+ , header 2 ("Second" <> space <> "Level")

214+ , para "Text"

215+ ]

216+

217+ , "Headers not preceded by a blank line" =:

218+ unlines [ "** eat dinner"

219+ , "Spaghetti and meatballs tonight."

220+ , "** walk dog"

221+ ] =?>

222+ mconcat [ header 2 ("eat" <> space <> "dinner")

223+ , para $ spcSep [ "Spaghetti", "and", "meatballs", "tonight." ]

224+ , header 2 ("walk" <> space <> "dog")

225+ ]

226+

227+ , "Paragraph starting with an asterisk" =:

228+ "*five" =?>

229+ para "*five"

230+

231+ , "Paragraph containing asterisk at beginning of line" =:

232+ unlines [ "lucky"

233+ , "*star"

234+ ] =?>

235+ para ("lucky" <> space <> "*star")

236+

237+ , "Example block" =:

238+ unlines [ ": echo hello"

239+ , ": echo dear tester"

240+ ] =?>

241+ codeBlockWith ("", ["example"], []) "echo hello\necho dear tester\n"

242+

243+ , "Example block surrounded by text" =:

244+ unlines [ "Greetings"

245+ , ": echo hello"

246+ , ": echo dear tester"

247+ , "Bye"

248+ ] =?>

249+ mconcat [ para "Greetings"

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

251+ "echo hello\necho dear tester\n"

252+ , para "Bye"

253+ ]

254+

255+ , "Horizontal Rule" =:

256+ unlines [ "before"

257+ , "-----"

258+ , "after"

259+ ] =?>

260+ mconcat [ para "before"

261+ , horizontalRule

262+ , para "after"

263+ ]

264+

265+ , "Not a Horizontal Rule" =:

266+ "----- five dashes" =?>

267+ (para $ spcSep [ "-----", "five", "dashes" ])

268+

269+ , "Comment Block" =:

270+ unlines [ "#+BEGIN_COMMENT"

271+ , "stuff"

272+ , "bla"

273+ , "#+END_COMMENT"] =?>

274+ (mempty::Blocks)

275+

276+ , "Source Block in Text" =:

277+ unlines [ "Low German greeting"

278+ , " #+BEGIN_SRC haskell"

279+ , " main = putStrLn greeting"

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

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

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

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

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

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

286+ , codeBlockWith attr' code'

287+ ]

288+

289+ , "Source Block" =:

290+ unlines [ " #+BEGIN_SRC haskell"

291+ , " main = putStrLn greeting"

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

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

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

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

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

297+ in codeBlockWith attr' code'

298+ ]

299+

300+ , testGroup "Lists" $

301+ [ "Simple Bullet Lists" =:

302+ ("- Item1\n" ++

303+ "- Item2\n") =?>

304+ bulletList [ plain "Item1"

305+ , plain "Item2"

306+ ]

307+

308+ , "Indented Bullet Lists" =:

309+ (" - Item1\n" ++

310+ " - Item2\n") =?>

311+ bulletList [ plain "Item1"

312+ , plain "Item2"

313+ ]

314+

315+ , "Multi-line Bullet Lists" =:

316+ ("- *Fat\n" ++

317+ " Tony*\n" ++

318+ "- /Sideshow\n" ++

319+ " Bob/") =?>

320+ bulletList [ plain $ strong ("Fat" <> space <> "Tony")

321+ , plain $ emph ("Sideshow" <> space <> "Bob")

322+ ]

323+

324+ , "Nested Bullet Lists" =:

325+ ("- Discovery\n" ++

326+ " + One More Time\n" ++

327+ " + Harder, Better, Faster, Stronger\n" ++

328+ "- Homework\n" ++

329+ " + Around the World\n"++

330+ "- Human After All\n" ++

331+ " + Technologic\n" ++

332+ " + Robot Rock\n") =?>

333+ bulletList [ mconcat

334+ [ para "Discovery"

335+ , bulletList [ plain ("One" <> space <>

336+ "More" <> space <>

337+ "Time")

338+ , plain ("Harder," <> space <>

339+ "Better," <> space <>

340+ "Faster," <> space <>

341+ "Stronger")

342+ ]

343+ ]

344+ , mconcat

345+ [ para "Homework"

346+ , bulletList [ plain ("Around" <> space <>

347+ "the" <> space <>

348+ "World")

349+ ]

350+ ]

351+ , mconcat

352+ [ para ("Human" <> space <> "After" <> space <> "All")

353+ , bulletList [ plain "Technologic"

354+ , plain ("Robot" <> space <> "Rock")

355+ ]

356+ ]

357+ ]

358+

359+ , "Simple Ordered List" =:

360+ ("1. Item1\n" ++

361+ "2. Item2\n") =?>

362+ let listStyle = (1, DefaultStyle, DefaultDelim)

363+ listStructure = [ plain "Item1"

364+ , plain "Item2"

365+ ]

366+ in orderedListWith listStyle listStructure

367+

368+ , "Simple Ordered List with Parens" =:

369+ ("1) Item1\n" ++

370+ "2) Item2\n") =?>

371+ let listStyle = (1, DefaultStyle, DefaultDelim)

372+ listStructure = [ plain "Item1"

373+ , plain "Item2"

374+ ]

375+ in orderedListWith listStyle listStructure

376+

377+ , "Indented Ordered List" =:

378+ (" 1. Item1\n" ++

379+ " 2. Item2\n") =?>

380+ let listStyle = (1, DefaultStyle, DefaultDelim)

381+ listStructure = [ plain "Item1"

382+ , plain "Item2"

383+ ]

384+ in orderedListWith listStyle listStructure

385+

386+ , "Nested Ordered Lists" =:

387+ ("1. One\n" ++

388+ " 1. One-One\n" ++

389+ " 2. One-Two\n" ++

390+ "2. Two\n" ++

391+ " 1. Two-One\n"++

392+ " 2. Two-Two\n") =?>

393+ let listStyle = (1, DefaultStyle, DefaultDelim)

394+ listStructure = [ mconcat

395+ [ para "One"

396+ , orderedList [ plain "One-One"

397+ , plain "One-Two"

398+ ]

399+ ]

400+ , mconcat

401+ [ para "Two"

402+ , orderedList [ plain "Two-One"

403+ , plain "Two-Two"

404+ ]

405+ ]

406+ ]

407+ in orderedListWith listStyle listStructure

408+

409+ , "Ordered List in Bullet List" =:

410+ ("- Emacs\n" ++

411+ " 1. Org\n") =?>

412+ bulletList [ (para "Emacs") <>

413+ (orderedList [ plain "Org"])

414+ ]

415+

416+ , "Bullet List in Ordered List" =:

417+ ("1. GNU\n" ++

418+ " - Freedom\n") =?>

419+ orderedList [ (para "GNU") <> bulletList [ (plain "Freedom") ] ]

420+ ]

421+

422+ , testGroup "Tables"

423+ [ "Single cell table" =:

424+ "|Test|" =?>

425+ simpleTable' 1 mempty [[plain "Test"]]

426+

427+ , "Multi cell table" =:

428+ "| One | Two |" =?>

429+ simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ]

430+

431+ , "Multi line table" =:

432+ unlines [ "| One |"

433+ , "| Two |"

434+ , "| Three |"

435+ ] =?>

436+ simpleTable' 1 mempty

437+ [ [ plain "One" ]

438+ , [ plain "Two" ]

439+ , [ plain "Three" ]

440+ ]

441+

442+ , "Empty table" =:

443+ "||" =?>

444+ simpleTable' 1 mempty mempty

445+

446+ , "Glider Table" =:

447+ unlines [ "| 1 | 0 | 0 |"

448+ , "| 0 | 1 | 1 |"

449+ , "| 1 | 1 | 0 |"

450+ ] =?>

451+ simpleTable' 3 mempty

452+ [ [ plain "1", plain "0", plain "0" ]

453+ , [ plain "0", plain "1", plain "1" ]

454+ , [ plain "1", plain "1", plain "0" ]

455+ ]

456+

457+ , "Table between Paragraphs" =:

458+ unlines [ "Before"

459+ , "| One | Two |"

460+ , "After"

461+ ] =?>

462+ mconcat [ para "Before"

463+ , simpleTable' 2 mempty [ [ plain "One", plain "Two" ] ]

464+ , para "After"

465+ ]

466+

467+ , "Table with Header" =:

468+ unlines [ "| Species | Status |"

469+ , "|--------------+--------------|"

470+ , "| cervisiae | domesticated |"

471+ , "| paradoxus | wild |"

472+ ] =?>

473+ simpleTable [ plain "Species", plain "Status" ]

474+ [ [ plain "cervisiae", plain "domesticated" ]

475+ , [ plain "paradoxus", plain "wild" ]

476+ ]

477+

478+ , "Table with final hline" =:

479+ unlines [ "| cervisiae | domesticated |"

480+ , "| paradoxus | wild |"

481+ , "|--------------+--------------|"

482+ ] =?>

483+ simpleTable' 2 mempty

484+ [ [ plain "cervisiae", plain "domesticated" ]

485+ , [ plain "paradoxus", plain "wild" ]

486+ ]

487+

488+ , "Table in a box" =:

489+ unlines [ "|---------|---------|"

490+ , "| static | Haskell |"

491+ , "| dynamic | Lisp |"

492+ , "|---------+---------|"

493+ ] =?>

494+ simpleTable' 2 mempty

495+ [ [ plain "static", plain "Haskell" ]

496+ , [ plain "dynamic", plain "Lisp" ]

497+ ]

498+

499+ , "Table with alignment row" =:

500+ unlines [ "| Numbers | Text | More |"

501+ , "| <c> | <r> | |"

502+ , "| 1 | One | foo |"

503+ , "| 2 | Two | bar |"

504+ ] =?>

505+ table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0])

506+ []

507+ [ [ plain "Numbers", plain "Text", plain "More" ]

508+ , [ plain "1" , plain "One" , plain "foo" ]

509+ , [ plain "2" , plain "Two" , plain "bar" ]

510+ ]

511+

512+ , "Pipe within text doesn't start a table" =:

513+ "Ceci n'est pas une | pipe " =?>

514+ para (spcSep [ "Ceci", "n'est", "pas", "une", "|", "pipe" ])

515+

516+ , "Missing pipe at end of row" =:

517+ "|incomplete-but-valid" =?>

518+ simpleTable' 1 mempty [ [ plain "incomplete-but-valid" ] ]

519+

520+ , "Table with differing row lengths" =:

521+ unlines [ "| Numbers | Text "

522+ , "|-"

523+ , "| <c> | <r> |"

524+ , "| 1 | One | foo |"

525+ , "| 2"

526+ ] =?>

527+ table "" (zip [AlignCenter, AlignRight, AlignDefault] [0, 0, 0])

528+ [ plain "Numbers", plain "Text" , plain mempty ]

529+ [ [ plain "1" , plain "One" , plain "foo" ]

530+ , [ plain "2" , plain mempty , plain mempty ]

531+ ]

532+ ]

533+ ]

tests/test-pandoc.hs+2

@@ -7,6 +7,7 @@ import GHC.IO.Encoding

7import qualified Tests.Old

8import qualified Tests.Readers.LaTeX

9import qualified Tests.Readers.Markdown

10+import qualified Tests.Readers.Org

10import qualified Tests.Readers.RST

11import qualified Tests.Readers.RST

11import qualified Tests.Writers.ConTeXt

12import qualified Tests.Writers.ConTeXt

12import qualified Tests.Writers.LaTeX

13import qualified Tests.Writers.LaTeX

@@ -31,6 +32,7 @@ tests = [ testGroup "Old" Tests.Old.tests

31 , testGroup "Readers"

32 , testGroup "Readers"

32 [ testGroup "LaTeX" Tests.Readers.LaTeX.tests

33 [ testGroup "LaTeX" Tests.Readers.LaTeX.tests

33 , testGroup "Markdown" Tests.Readers.Markdown.tests

34 , testGroup "Markdown" Tests.Readers.Markdown.tests

35+ , testGroup "Org" Tests.Readers.Org.tests

34 , testGroup "RST" Tests.Readers.RST.tests

36 , testGroup "RST" Tests.Readers.RST.tests

35 ]

37 ]

36 ]

38 ]