1dda535 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: refactor block attribute handling

1dda535Albert Krewinkel10 years ago

src/Text/Pandoc/Readers/Org.hs+77−79

compare with master

unifiedsplit

@@ -49,10 +49,10 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

49import Control.Arrow (first)

50import Control.Monad (foldM, guard, mplus, mzero, when)

51import Control.Monad.Reader ( Reader, runReader )

52−import Data.Char (isAlphaNum, isSpace, toLower)

52+import Data.Char (isAlphaNum, isSpace, toLower, toUpper)

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

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

54import qualified Data.Map as M

55−import Data.Maybe (fromMaybe, isJust)

55+import Data.Maybe ( fromMaybe, isNothing )

56import Network.HTTP (urlEncode)

@@ -273,11 +273,9 @@ parseBlocks = mconcat <$> manyTill block eof

273

274block :: OrgParser (F Blocks)

275block = choice [ mempty <$ blanklines

276− , optionalAttributes $ choice

276+ , table

277− [ orgBlock

277+ , orgBlock

278− , figure

278+ , figure

279− , table

280− ]

281 , example

279 , example

282 , drawer

280 , drawer

283 , specialLine

281 , specialLine

@@ -289,50 +287,53 @@ block = choice [ mempty <$ blanklines

289 , paraOrPlain

287 , paraOrPlain

290 ] <?> "block"

288 ] <?> "block"

291

289

290+

292--

291--

293-- Block Attributes

292-- Block Attributes

294--

293--

295

294

296−-- | Parse optional block attributes (like #+TITLE or #+NAME)

295+-- | Attributes that may be added to figures (like a name or caption).

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

296+data BlockAttributes = BlockAttributes

298−optionalAttributes parser = try $

297+ { blockAttrName :: Maybe String

299− resetBlockAttributes *> parseBlockAttributes *> parser

298+ , blockAttrCaption :: Maybe (F Inlines)

300− where

299+ }

301− resetBlockAttributes :: OrgParser ()

300+

302− resetBlockAttributes = updateState $ \s ->

301+stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String)

303− s{ orgStateBlockAttributes = orgStateBlockAttributes def }

302+stringyMetaAttribute attrCheck = try $ do

304−

303+ metaLineStart

305−parseBlockAttributes :: OrgParser ()

304+ attrName <- map toUpper <$> many1Till nonspaceChar (char ':')

306−parseBlockAttributes = do

305+ guard $ attrCheck attrName

307− attrs <- many attribute

306+ skipSpaces

308− mapM_ (uncurry parseAndAddAttribute) attrs

307+ attrValue <- manyTill anyChar newline

308+ return (attrName, attrValue)

309+

310+blockAttributes :: OrgParser BlockAttributes

311+blockAttributes = try $ do

312+ kv <- many (stringyMetaAttribute attrCheck)

313+ let caption = foldl' (appendValues "CAPTION") Nothing kv

314+ let name = lookup "NAME" kv

315+ caption' <- maybe (return Nothing)

316+ (fmap Just . parseFromString parseInlines)

317+ caption

318+ return $ BlockAttributes

319+ { blockAttrName = name

320+ , blockAttrCaption = caption'

321+ }

309 where

322 where

310− attribute :: OrgParser (String, String)

323+ attrCheck :: String -> Bool

311− attribute = try $ do

324+ attrCheck attr =

312− key <- metaLineStart *> many1Till nonspaceChar (char ':')

325+ case attr of

313− val <- skipSpaces *> anyLine

326+ "NAME" -> True

314− return (map toLower key, val)

327+ "CAPTION" -> True

315−

328+ _ -> False

316−parseAndAddAttribute :: String -> String -> OrgParser ()

329+

317−parseAndAddAttribute key value = do

330+ appendValues :: String -> Maybe String -> (String, String) -> Maybe String

318− let key' = map toLower key

331+ appendValues attrName accValue (key, value) =

319− () <$ addBlockAttribute key' value

332+ if key /= attrName

320−

333+ then accValue

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

334+ else case accValue of

322−lookupInlinesAttr attr = try $ do

335+ Just acc -> Just $ acc ++ ' ':value

323− val <- lookupBlockAttribute attr

324− maybe (return Nothing)

336+ Nothing -> Just value

325− (fmap Just . parseFromString parseInlines)

326− val

327−

328−addBlockAttribute :: String -> String -> OrgParser ()

329−addBlockAttribute key val = updateState $ \s ->

330− let attrs = orgStateBlockAttributes s

331− in s{ orgStateBlockAttributes = M.insert key val attrs }

332−

333−lookupBlockAttribute :: String -> OrgParser (Maybe String)

334−lookupBlockAttribute key =

335− M.lookup key . orgStateBlockAttributes <$> getState

336

337

338

338--

339--

@@ -346,6 +347,7 @@ updateIndent (_, blkType) indent = (indent, blkType)

346

347

347orgBlock :: OrgParser (F Blocks)

348orgBlock :: OrgParser (F Blocks)

348orgBlock = try $ do

349orgBlock = try $ do

350+ blockAttrs <- blockAttributes

349 blockProp@(_, blkType) <- blockHeaderStart

351 blockProp@(_, blkType) <- blockHeaderStart

350 ($ blockProp) $

352 ($ blockProp) $

351 case blkType of

353 case blkType of

@@ -356,7 +358,7 @@ orgBlock = try $ do

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

358 "example" -> withRaw' (return . exampleCode)

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

359 "quote" -> withParsed (fmap B.blockQuote)

358 "verse" -> verseBlock

360 "verse" -> verseBlock

359− "src" -> codeBlock

361+ "src" -> codeBlock blockAttrs

360 _ -> withParsed (fmap $ divWithClass blkType)

362 _ -> withParsed (fmap $ divWithClass blkType)

361

363

362blockHeaderStart :: OrgParser (Int, String)

364blockHeaderStart :: OrgParser (Int, String)

@@ -410,20 +412,20 @@ followingResultsBlock =

410 *> blankline

412 *> blankline

411 *> block)

413 *> block)

412

414

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

415+codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)

414−codeBlock blkProp = do

416+codeBlock blockAttrs blkProp = do

415 skipSpaces

417 skipSpaces

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

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

417− id' <- fromMaybe "" <$> lookupBlockAttribute "name"

418 leadingIndent <- lookAhead indentation

419 leadingIndent <- lookAhead indentation

419 content <- rawBlockContent (updateIndent blkProp leadingIndent)

420 content <- rawBlockContent (updateIndent blkProp leadingIndent)

420 resultsContent <- followingResultsBlock

421 resultsContent <- followingResultsBlock

422+ let id' = fromMaybe mempty $ blockAttrName blockAttrs

421 let includeCode = exportsCode kv

423 let includeCode = exportsCode kv

422 let includeResults = exportsResults kv

424 let includeResults = exportsResults kv

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

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

424− labelledBlck <- maybe (pure codeBlck)

426+ let labelledBlck = maybe (pure codeBlck)

425 (labelDiv codeBlck)

427 (labelDiv codeBlck)

426− <$> lookupInlinesAttr "caption"

428+ (blockAttrCaption blockAttrs)

427 let resultBlck = fromMaybe mempty resultsContent

429 let resultBlck = fromMaybe mempty resultsContent

428 return $ (if includeCode then labelledBlck else mempty)

430 return $ (if includeCode then labelledBlck else mempty)

429 <> (if includeResults then resultBlck else mempty)

431 <> (if includeResults then resultBlck else mempty)

@@ -579,47 +581,42 @@ drawerEnd = try $

579-- Figures

581-- Figures

580--

582--

581

583

584+

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

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

583figure :: OrgParser (F Blocks)

586figure :: OrgParser (F Blocks)

584figure = try $ do

587figure = try $ do

585− (cap, nam) <- nameAndCaption

588+ figAttrs <- blockAttributes

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

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

590+ guard . not . isNothing . blockAttrCaption $ figAttrs

587 guard (isImageFilename src)

591 guard (isImageFilename src)

588− return $ do

592+ let figName = fromMaybe mempty $ blockAttrName figAttrs

589− cap' <- cap

593+ let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs

590− return $ B.para $ B.image src nam cap'

594+ return $ (B.para . B.image src (withFigPrefix figName) <$> figCaption)

591 where

595 where

592− nameAndCaption =

593− do

594− maybeCap <- lookupInlinesAttr "caption"

595− maybeNam <- lookupBlockAttribute "name"

596− guard $ isJust maybeCap || isJust maybeNam

597− return ( fromMaybe mempty maybeCap

598− , withFigPrefix $ fromMaybe mempty maybeNam )

599 withFigPrefix cs =

596 withFigPrefix cs =

600− if "fig:" `isPrefixOf` cs

597+ if "fig:" `isPrefixOf` cs

601− then cs

598+ then cs

602− else "fig:" ++ cs

599+ else "fig:" ++ cs

603

600

604--

601--

605-- Comments, Options and Metadata

602-- Comments, Options and Metadata

603+--

606specialLine :: OrgParser (F Blocks)

604specialLine :: OrgParser (F Blocks)

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

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

608

606

609metaLine :: OrgParser Blocks

607metaLine :: OrgParser Blocks

610−metaLine = try $ mempty

611− <$ (metaLineStart *> (optionLine <|> declarationLine))

608+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

612−

613−commentLine :: OrgParser Blocks

614−commentLine = try $ commentLineStart *> anyLine *> pure mempty

615

609

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

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

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

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

618−metaLineStart :: OrgParser String

612+metaLineStart :: OrgParser ()

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

613+metaLineStart = try $ skipSpaces <* string "#+"

614+

615+commentLine :: OrgParser Blocks

616+commentLine = commentLineStart *> anyLine *> pure mempty

620

617

621−commentLineStart :: OrgParser String

618+commentLineStart :: OrgParser ()

622−commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

619+commentLineStart = try $ skipSpaces <* string "# "

623

620

624declarationLine :: OrgParser ()

621declarationLine :: OrgParser ()

625declarationLine = try $ do

622declarationLine = try $ do

@@ -738,11 +735,12 @@ data OrgTable = OrgTable

738

735

739table :: OrgParser (F Blocks)

736table :: OrgParser (F Blocks)

740table = try $ do

737table = try $ do

738+ blockAttrs <- blockAttributes

741 lookAhead tableStart

739 lookAhead tableStart

742 do

740 do

743 rows <- tableRows

741 rows <- tableRows

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

742+ let caption = fromMaybe (return mempty) $ blockAttrCaption blockAttrs

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

743+ return $ (<$> caption) . orgToPandocTable . normalizeTable =<< rowsToTable rows

746

744

747orgToPandocTable :: OrgTable

745orgToPandocTable :: OrgTable

748 -> Inlines

746 -> Inlines

src/Text/Pandoc/Readers/Org/ParserState.hs−4

@@ -68,8 +68,6 @@ import Text.Pandoc.Parsing ( HasHeaderMap(..)

68type OrgNoteRecord = (String, F Blocks)

69-- | Table of footnotes

70type OrgNoteTable = [OrgNoteRecord]

71−-- | Map of org block attributes (e.g. LABEL, CAPTION, NAME, etc)

72−type OrgBlockAttributes = M.Map String String

73-- | Map of functions for link transformations. The map key is refers to the

71-- | Map of functions for link transformations. The map key is refers to the

74-- link-type, the corresponding function transforms the given link string.

72-- link-type, the corresponding function transforms the given link string.

75type OrgLinkFormatters = M.Map String (String -> String)

73type OrgLinkFormatters = M.Map String (String -> String)

@@ -84,7 +82,6 @@ data ExportSettings = ExportSettings

84data OrgParserState = OrgParserState

82data OrgParserState = OrgParserState

85 { orgStateOptions :: ReaderOptions

83 { orgStateOptions :: ReaderOptions

86 , orgStateAnchorIds :: [String]

84 , orgStateAnchorIds :: [String]

87− , orgStateBlockAttributes :: OrgBlockAttributes

88 , orgStateEmphasisCharStack :: [Char]

85 , orgStateEmphasisCharStack :: [Char]

89 , orgStateEmphasisNewlines :: Maybe Int

86 , orgStateEmphasisNewlines :: Maybe Int

90 , orgStateExportSettings :: ExportSettings

87 , orgStateExportSettings :: ExportSettings

@@ -140,7 +137,6 @@ defaultOrgParserState :: OrgParserState

140defaultOrgParserState = OrgParserState

137defaultOrgParserState = OrgParserState

141 { orgStateOptions = def

138 { orgStateOptions = def

142 , orgStateAnchorIds = []

139 , orgStateAnchorIds = []

143− , orgStateBlockAttributes = M.empty

144 , orgStateEmphasisCharStack = []

140 , orgStateEmphasisCharStack = []

145 , orgStateEmphasisNewlines = Nothing

141 , orgStateEmphasisNewlines = Nothing

146 , orgStateExportSettings = def

142 , orgStateExportSettings = def