669ecbd · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #2954 from tarleb/org-export-blocks

669ecbdJohn MacFarlane10 years ago

src/Text/Pandoc/Readers/Org/Blocks.hs+146−117

compare with master

unifiedsplit

@@ -45,7 +45,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )

46import Control.Arrow ( first )

47import Control.Monad ( foldM, guard, mzero )

48−import Data.Char ( toLower, toUpper)

48+import Data.Char ( isSpace, toLower, toUpper)

49import Data.List ( foldl', intersperse, isPrefixOf )

50import qualified Data.Map as M

51import Data.Maybe ( fromMaybe, isNothing )

@@ -116,7 +116,7 @@ blockAttributes = try $ do

116 let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv

117 let name = lookup "NAME" kv

118 caption' <- maybe (return Nothing)

119− (fmap Just . parseFromString parseInlines)

119+ (fmap Just . parseFromString inlines)

120 caption

121 kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs

122 return $ BlockAttributes

@@ -161,85 +161,109 @@ keyValues = try $

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

162--

163

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

164+-- | Read an org-mode block delimited by #+BEGIN_TYPE and #+END_TYPE.

165−

166−updateIndent :: BlockProperties -> Int -> BlockProperties

167−updateIndent (_, blkType) indent = (indent, blkType)

168−

169orgBlock :: OrgParser (F Blocks)

165orgBlock :: OrgParser (F Blocks)

170orgBlock = try $ do

166orgBlock = try $ do

171 blockAttrs <- blockAttributes

167 blockAttrs <- blockAttributes

172− blockProp@(_, blkType) <- blockHeaderStart

168+ blkType <- blockHeaderStart

173− ($ blockProp) $

169+ ($ blkType) $

174 case blkType of

170 case blkType of

171+ "export" -> exportBlock

175− "comment" -> withRaw' (const mempty)

172+ "comment" -> rawBlockLines (const mempty)

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

173+ "html" -> rawBlockLines (return . (B.rawBlock blkType))

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

174+ "latex" -> rawBlockLines (return . (B.rawBlock blkType))

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

175+ "ascii" -> rawBlockLines (return . (B.rawBlock blkType))

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

176+ "example" -> rawBlockLines (return . exampleCode)

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

177+ "quote" -> parseBlockLines (fmap B.blockQuote)

181 "verse" -> verseBlock

178 "verse" -> verseBlock

182 "src" -> codeBlock blockAttrs

179 "src" -> codeBlock blockAttrs

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

180+ _ -> parseBlockLines (fmap $ B.divWith (mempty, [blkType], mempty))

184−

185−blockHeaderStart :: OrgParser (Int, String)

186−blockHeaderStart = try $ (,) <$> indentation <*> blockType

187 where

181 where

182+ blockHeaderStart :: OrgParser String

183+ blockHeaderStart = try $ do

184+ skipSpaces

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

185+ blockType <- stringAnyCase "#+begin_" *> orgArgWord

186+ return (map toLower blockType)

189

187

190−indentation :: OrgParser Int

188+rawBlockLines :: (String -> F Blocks) -> String -> OrgParser (F Blocks)

191−indentation = try $ do

189+rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))

192− tabStop <- getOption readerTabStop

193− s <- many spaceChar

194− return $ spaceLength tabStop s

195

190

196−spaceLength :: Int -> String -> Int

191+parseBlockLines :: (F Blocks -> F Blocks) -> String -> OrgParser (F Blocks)

197−spaceLength tabStop s = (sum . map charLen) s

192+parseBlockLines f blockType = (ignHeaders *> (f <$> parsedBlockContent))

198 where

193 where

199− charLen ' ' = 1

194+ parsedBlockContent :: OrgParser (F Blocks)

200− charLen '\t' = tabStop

195+ parsedBlockContent = try $ do

201− charLen _ = 0

196+ raw <- rawBlockContent blockType

202−

197+ parseFromString blocks (raw ++ "\n")

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

198+

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

199+-- | Read the raw string content of a block

205−

200+rawBlockContent :: String -> OrgParser String

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

201+rawBlockContent blockType = try $ do

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

202+ blkLines <- manyTill rawLine blockEnder

208−

203+ tabLen <- getOption readerTabStop

204+ return

205+ . unlines

206+ . stripIndent

207+ . map (tabsToSpaces tabLen . commaEscaped)

208+ $ blkLines

209+ where

210+ rawLine :: OrgParser String

211+ rawLine = try $ ("" <$ blankline) <|> anyLine

212+

213+ blockEnder :: OrgParser ()

214+ blockEnder = try $ skipSpaces <* stringAnyCase ("#+end_" <> blockType)

215+

216+ stripIndent :: [String] -> [String]

217+ stripIndent strs = map (drop (shortestIndent strs)) strs

218+

219+ shortestIndent :: [String] -> Int

220+ shortestIndent = minimum

221+ . map (length . takeWhile isSpace)

222+ . filter (not . null)

223+

224+ tabsToSpaces :: Int -> String -> String

225+ tabsToSpaces _ [] = []

226+ tabsToSpaces tabLen cs'@(c:cs) =

227+ case c of

228+ ' ' -> ' ':tabsToSpaces tabLen cs

229+ '\t' -> (take tabLen $ repeat ' ') ++ tabsToSpaces tabLen cs

230+ _ -> cs'

231+

232+ commaEscaped :: String -> String

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

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

235+ commaEscaped (' ':cs) = ' ':commaEscaped cs

236+ commaEscaped ('\t':cs) = '\t':commaEscaped cs

237+ commaEscaped cs = cs

238+

239+-- | Read but ignore all remaining block headers.

209ignHeaders :: OrgParser ()

240ignHeaders :: OrgParser ()

210ignHeaders = (() <$ newline) <|> (() <$ anyLine)

241ignHeaders = (() <$ newline) <|> (() <$ anyLine)

211

242

212−divWithClass :: String -> Blocks -> Blocks

243+-- | Read a block containing code intended for export in specific backends

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

244+-- only.

245+exportBlock :: String -> OrgParser (F Blocks)

246+exportBlock blockType = try $ do

247+ exportType <- skipSpaces *> orgArgWord <* ignHeaders

248+ contents <- rawBlockContent blockType

249+ returnF (B.rawBlock (map toLower exportType) contents)

214

250

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

251+verseBlock :: String -> OrgParser (F Blocks)

216−verseBlock blkProp = try $ do

252+verseBlock blockType = try $ do

217 ignHeaders

253 ignHeaders

218− content <- rawBlockContent blkProp

254+ content <- rawBlockContent blockType

219 fmap B.para . mconcat . intersperse (pure B.linebreak)

255 fmap B.para . mconcat . intersperse (pure B.linebreak)

220− <$> mapM (parseFromString parseInlines) (map (++ "\n") . lines $ content)

256+ <$> mapM (parseFromString inlines) (map (++ "\n") . lines $ content)

221−

222−exportsCode :: [(String, String)] -> Bool

223−exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs

224− || ("rundoc-exports", "results") `elem` attrs)

225−

226−exportsResults :: [(String, String)] -> Bool

227−exportsResults attrs = ("rundoc-exports", "results") `elem` attrs

228− || ("rundoc-exports", "both") `elem` attrs

229−

230−followingResultsBlock :: OrgParser (Maybe (F Blocks))

231−followingResultsBlock =

232− optionMaybe (try $ blanklines *> stringAnyCase "#+RESULTS:"

233− *> blankline

234− *> block)

235

257

258+-- | Read a code block and the associated results block if present. Which of

259+-- boths blocks is included in the output is determined using the "exports"

260+-- argument in the block header.

236−codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)

261+codeBlock :: BlockAttributes -> String -> OrgParser (F Blocks)

237−codeBlock blockAttrs blkProp = do

262+codeBlock blockAttrs blockType = do

238 skipSpaces

263 skipSpaces

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

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

240− leadingIndent <- lookAhead indentation

241− content <- rawBlockContent (updateIndent blkProp leadingIndent)

265+ content <- rawBlockContent blockType

242− resultsContent <- followingResultsBlock

266+ resultsContent <- trailingResultsBlock

243 let id' = fromMaybe mempty $ blockAttrName blockAttrs

267 let id' = fromMaybe mempty $ blockAttrName blockAttrs

244 let includeCode = exportsCode kv

268 let includeCode = exportsCode kv

245 let includeResults = exportsResults kv

269 let includeResults = exportsResults kv

@@ -248,36 +272,31 @@ codeBlock blockAttrs blkProp = do

248 (labelDiv codeBlck)

272 (labelDiv codeBlck)

249 (blockAttrCaption blockAttrs)

273 (blockAttrCaption blockAttrs)

250 let resultBlck = fromMaybe mempty resultsContent

274 let resultBlck = fromMaybe mempty resultsContent

275+ return $

251− return $ (if includeCode then labelledBlck else mempty)

276+ (if includeCode then labelledBlck else mempty) <>

252− <> (if includeResults then resultBlck else mempty)

277+ (if includeResults then resultBlck else mempty)

253 where

278 where

279+ labelDiv :: Blocks -> F Inlines -> F Blocks

254 labelDiv blk value =

280 labelDiv blk value =

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

281+ B.divWith nullAttr <$> (mappend <$> labelledBlock value <*> pure blk)

256− <*> pure blk)

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

258

282

259−rawBlockContent :: BlockProperties -> OrgParser String

283+ labelledBlock :: F Inlines -> F Blocks

260−rawBlockContent (indent, blockType) = try $

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

261− unlines . map commaEscaped <$> manyTill indentedLine blockEnder

262− where

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

264− blockEnder = try $ skipSpaces *> stringAnyCase ("#+end_" <> blockType)

265

285

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

286+exportsCode :: [(String, String)] -> Bool

267−parsedBlockContent blkProps = try $ do

287+exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs

268− raw <- rawBlockContent blkProps

288+ || ("rundoc-exports", "results") `elem` attrs)

269− parseFromString blocks (raw ++ "\n")

270

289

271−-- indent by specified number of spaces (or equiv. tabs)

290+exportsResults :: [(String, String)] -> Bool

272−indentWith :: Int -> OrgParser String

291+exportsResults attrs = ("rundoc-exports", "results") `elem` attrs

273−indentWith num = do

292+ || ("rundoc-exports", "both") `elem` attrs

274− tabStop <- getOption readerTabStop

275− if num < tabStop

276− then count num (char ' ')

277− else choice [ try (count num (char ' '))

278− , try (char '\t' >> count (num - tabStop) (char ' ')) ]

279

293

280−type SwitchOption = (Char, Maybe String)

294+trailingResultsBlock :: OrgParser (Maybe (F Blocks))

295+trailingResultsBlock = optionMaybe . try $ do

296+ blanklines

297+ stringAnyCase "#+RESULTS:"

298+ blankline

299+ block

281

300

282-- | Parse code block arguments

301-- | Parse code block arguments

283-- TODO: We currently don't handle switches.

302-- TODO: We currently don't handle switches.

@@ -297,8 +316,7 @@ codeHeaderArgs = try $ do

297 hasRundocParameters = not . null

316 hasRundocParameters = not . null

298 toRundocAttrib = first ("rundoc-" ++)

317 toRundocAttrib = first ("rundoc-" ++)

299

318

300−

301−switch :: OrgParser SwitchOption

319+switch :: OrgParser (Char, Maybe String)

302switch = try $ simpleSwitch <|> lineNumbersSwitch

320switch = try $ simpleSwitch <|> lineNumbersSwitch

303 where

321 where

304 simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)

322 simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)

@@ -334,24 +352,9 @@ orgParamValue :: OrgParser String

334orgParamValue = try $

352orgParamValue = try $

335 skipSpaces

353 skipSpaces

336 *> notFollowedBy (char ':' )

354 *> notFollowedBy (char ':' )

337− *> many1 (noneOf "\t\n\r ")

355+ *> many1 nonspaceChar

338 <* skipSpaces

356 <* skipSpaces

339

357

340−commaEscaped :: String -> String

341−commaEscaped (',':cs@('*':_)) = cs

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

343−commaEscaped cs = cs

344−

345−example :: OrgParser (F Blocks)

346−example = try $ do

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

348−

349−exampleCode :: String -> Blocks

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

351−

352−exampleLine :: OrgParser String

353−exampleLine = try $ exampleLineStart *> anyLine

354−

355horizontalRule :: OrgParser (F Blocks)

358horizontalRule :: OrgParser (F Blocks)

356horizontalRule = return B.horizontalRule <$ try hline

359horizontalRule = return B.horizontalRule <$ try hline

357

360

@@ -444,18 +447,26 @@ figure = try $ do

444 selfTarget :: OrgParser String

447 selfTarget :: OrgParser String

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

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

446

449

450+--

451+-- Examples

452+--

453+

454+-- | Example code marked up by a leading colon.

455+example :: OrgParser (F Blocks)

456+example = try $ do

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

458+ where

459+ exampleLine :: OrgParser String

460+ exampleLine = try $ exampleLineStart *> anyLine

461+

462+exampleCode :: String -> Blocks

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

464+

447

465

448--

466--

449-- Comments, Options and Metadata

467-- Comments, Options and Metadata

450--

468--

451

469

452−addLinkFormat :: String

453− -> (String -> String)

454− -> OrgParser ()

455−addLinkFormat key formatter = updateState $ \s ->

456− let fs = orgStateLinkFormatters s

457− in s{ orgStateLinkFormatters = M.insert key formatter fs }

458−

459specialLine :: OrgParser (F Blocks)

470specialLine :: OrgParser (F Blocks)

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

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

461

472

@@ -492,6 +503,14 @@ optionLine = try $ do

492 "options" -> () <$ sepBy spaces exportSetting

503 "options" -> () <$ sepBy spaces exportSetting

493 _ -> mzero

504 _ -> mzero

494

505

506+addLinkFormat :: String

507+ -> (String -> String)

508+ -> OrgParser ()

509+addLinkFormat key formatter = updateState $ \s ->

510+ let fs = orgStateLinkFormatters s

511+ in s{ orgStateLinkFormatters = M.insert key formatter fs }

512+

513+

495--

514--

496-- Export Settings

515-- Export Settings

497--

516--

@@ -618,10 +637,10 @@ header = try $ do

618 title <- manyTill inline (lookAhead $ optional headerTags <* newline)

637 title <- manyTill inline (lookAhead $ optional headerTags <* newline)

619 tags <- option [] headerTags

638 tags <- option [] headerTags

620 newline

639 newline

640+ let text = tagTitle title tags

621 propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)

641 propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)

622− inlines <- runF (tagTitle title tags) <$> getState

623− attr <- registerHeader propAttr inlines

642+ attr <- registerHeader propAttr (runF text def)

624− return $ pure (B.headerWith attr level inlines)

643+ return (B.headerWith attr level <$> text)

625 where

644 where

626 tagTitle :: [F Inlines] -> [String] -> F Inlines

645 tagTitle :: [F Inlines] -> [String] -> F Inlines

627 tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags

646 tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags

@@ -799,7 +818,7 @@ noteBlock = try $ do

799-- Paragraphs or Plain text

818-- Paragraphs or Plain text

800paraOrPlain :: OrgParser (F Blocks)

819paraOrPlain :: OrgParser (F Blocks)

801paraOrPlain = try $ do

820paraOrPlain = try $ do

802− ils <- parseInlines

821+ ils <- inlines

803 nl <- option False (newline *> return True)

822 nl <- option False (newline *> return True)

804 -- Read block as paragraph, except if we are in a list context and the block

823 -- Read block as paragraph, except if we are in a list context and the block

805 -- is directly followed by a list item, in which case the block is read as

824 -- is directly followed by a list item, in which case the block is read as

@@ -858,7 +877,7 @@ definitionListItem parseMarkerGetLength = try $ do

858 line1 <- anyLineNewline

877 line1 <- anyLineNewline

859 blank <- option "" ("\n" <$ blankline)

878 blank <- option "" ("\n" <$ blankline)

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

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

861− term' <- parseFromString parseInlines term

880+ term' <- parseFromString inlines term

862 contents' <- parseFromString blocks $ line1 ++ blank ++ cont

881 contents' <- parseFromString blocks $ line1 ++ blank ++ cont

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

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

864 where

883 where

@@ -884,7 +903,17 @@ listContinuation markerLength = try $

884 notFollowedBy' blankline

903 notFollowedBy' blankline

885 *> (mappend <$> (concat <$> many1 listLine)

904 *> (mappend <$> (concat <$> many1 listLine)

886 <*> many blankline)

905 <*> many blankline)

906+ where

887− where listLine = try $ indentWith markerLength *> anyLineNewline

907+ listLine = try $ indentWith markerLength *> anyLineNewline

908+

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

910+ indentWith :: Int -> OrgParser String

911+ indentWith num = do

912+ tabStop <- getOption readerTabStop

913+ if num < tabStop

914+ then count num (char ' ')

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

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

888

917

889-- | Parse any line, include the final newline in the output.

918-- | Parse any line, include the final newline in the output.

890anyLineNewline :: OrgParser String

919anyLineNewline :: OrgParser String

src/Text/Pandoc/Readers/Org/Inlines.hs+4−3

@@ -28,8 +28,8 @@ Parsers for Org-mode inline elements.

28-}

29module Text.Pandoc.Readers.Org.Inlines

30 ( inline

31+ , inlines

31 , addToNotesTable

32 , addToNotesTable

32− , parseInlines

33 , isImageFilename

34 , linkTarget

35 ) where

@@ -145,8 +145,9 @@ inline =

145 ] <* (guard =<< newlinesCountWithinLimits)

146 <?> "inline"

147

148+-- | Read the rest of the input as inlines.

148−parseInlines :: OrgParser (F Inlines)

149+inlines :: OrgParser (F Inlines)

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

150+inlines = trimInlinesF . mconcat <$> many1 inline

150

151

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

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

152specialChars :: [Char]

153specialChars :: [Char]

tests/Tests/Readers/Org.hs+15−1

@@ -1293,7 +1293,7 @@ tests =

1293 ]

1294 ]

1295

1296− , "Verse block with newlines" =:

1296+ , "Verse block with blank lines" =:

1297 unlines [ "#+BEGIN_VERSE"

1298 , "foo"

1299 , ""

@@ -1302,6 +1302,20 @@ tests =

1302 ] =?>

1303 para ("foo" <> linebreak <> linebreak <> "bar")

1304

1305+ , "Raw block LaTeX" =:

1306+ unlines [ "#+BEGIN_LaTeX"

1307+ , "The category $\\cat{Set}$ is adhesive."

1308+ , "#+END_LaTeX"

1309+ ] =?>

1310+ rawBlock "latex" "The category $\\cat{Set}$ is adhesive.\n"

1311+

1312+ , "Export block HTML" =:

1313+ unlines [ "#+BEGIN_export html"

1314+ , "<samp>Hello, World!</samp>"

1315+ , "#+END_export"

1316+ ] =?>

1317+ rawBlock "html" "<samp>Hello, World!</samp>\n"

1318+

1305 , "LaTeX fragment" =:

1319 , "LaTeX fragment" =:

1306 unlines [ "\\begin{equation}"

1320 unlines [ "\\begin{equation}"

1307 , "X_i = \\begin{cases}"

1321 , "X_i = \\begin{cases}"