c4cf6d2 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: support archived trees export options

c4cf6d2Albert Krewinkel10 years ago

src/Text/Pandoc/Readers/Org/Blocks.hs+43−6

compare with master

unifiedsplit

@@ -137,27 +137,43 @@ headlineToBlocks :: Headline -> OrgParser Blocks

137headlineToBlocks hdln@(Headline {..}) =

138 case () of

139 _ | any isNoExportTag headlineTags -> return mempty

140+ _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln

140 _ | isCommentTitle headlineText -> return mempty

141 _ | isCommentTitle headlineText -> return mempty

141− _ -> headlineToHeader hdln

142+ _ -> headlineToHeaderWithContents hdln

142

143

143isNoExportTag :: Tag -> Bool

144isNoExportTag :: Tag -> Bool

144isNoExportTag = (== toTag "noexport")

145isNoExportTag = (== toTag "noexport")

145

146

147+isArchiveTag :: Tag -> Bool

148+isArchiveTag = (== toTag "ARCHIVE")

149+

146-- | Check if the title starts with COMMENT.

150-- | Check if the title starts with COMMENT.

147-- FIXME: This accesses builder internals not intended for use in situations

151-- FIXME: This accesses builder internals not intended for use in situations

148−-- as these. Replace once keyword parsing is supported.

152+-- like these. Replace once keyword parsing is supported.

149isCommentTitle :: Inlines -> Bool

153isCommentTitle :: Inlines -> Bool

150isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"

154isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"

151isCommentTitle _ = False

155isCommentTitle _ = False

152

156

157+archivedHeadlineToBlocks :: Headline -> OrgParser Blocks

158+archivedHeadlineToBlocks hdln = do

159+ archivedTreesOption <- getExportSetting exportArchivedTrees

160+ case archivedTreesOption of

161+ ArchivedTreesNoExport -> return mempty

162+ ArchivedTreesExport -> headlineToHeaderWithContents hdln

163+ ArchivedTreesHeadlineOnly -> headlineToHeader hdln

164+

165+headlineToHeaderWithContents :: Headline -> OrgParser Blocks

166+headlineToHeaderWithContents hdln@(Headline {..}) = do

167+ header <- headlineToHeader hdln

168+ childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)

169+ return $ header <> headlineContents <> childrenBlocks

170+

153headlineToHeader :: Headline -> OrgParser Blocks

171headlineToHeader :: Headline -> OrgParser Blocks

154headlineToHeader (Headline {..}) = do

172headlineToHeader (Headline {..}) = do

155 let text = tagTitle headlineText headlineTags

173 let text = tagTitle headlineText headlineTags

156 let propAttr = propertiesToAttr headlineProperties

174 let propAttr = propertiesToAttr headlineProperties

157 attr <- registerHeader propAttr headlineText

175 attr <- registerHeader propAttr headlineText

158− let header = B.headerWith attr headlineLevel text

176+ return $ B.headerWith attr headlineLevel text

159− childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)

160− return $ header <> headlineContents <> childrenBlocks

161

177

162propertiesToAttr :: Properties -> Attr

178propertiesToAttr :: Properties -> Attr

163propertiesToAttr properties =

179propertiesToAttr properties =

@@ -629,7 +645,7 @@ exportSetting = choice

629 , ignoredSetting ":"

645 , ignoredSetting ":"

630 , ignoredSetting "<"

646 , ignoredSetting "<"

631 , ignoredSetting "\\n"

647 , ignoredSetting "\\n"

632− , ignoredSetting "arch"

648+ , archivedTreeSetting "arch" setExportArchivedTrees

633 , ignoredSetting "author"

649 , ignoredSetting "author"

634 , ignoredSetting "c"

650 , ignoredSetting "c"

635 , ignoredSetting "creator"

651 , ignoredSetting "creator"

@@ -673,6 +689,27 @@ elispBoolean = try $ do

673 "()" -> False

689 "()" -> False

674 _ -> True

690 _ -> True

675

691

692+archivedTreeSetting :: String

693+ -> ExportSettingSetter ArchivedTreesOption

694+ -> OrgParser ()

695+archivedTreeSetting settingIdentifier setter = try $ do

696+ string settingIdentifier

697+ char ':'

698+ value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean

699+ updateState $ modifyExportSettings setter value

700+ where

701+ archivedTreesHeadlineSetting = try $ do

702+ string "headline"

703+ lookAhead (newline <|> spaceChar)

704+ return ArchivedTreesHeadlineOnly

705+

706+ archivedTreesBoolean = try $ do

707+ exportBool <- elispBoolean

708+ return $

709+ if exportBool

710+ then ArchivedTreesExport

711+ else ArchivedTreesNoExport

712+

676-- | A list or a complement list (i.e. a list starting with `not`).

713-- | A list or a complement list (i.e. a list starting with `not`).

677complementableListSetting :: String

714complementableListSetting :: String

678 -> ExportSettingSetter (Either [String] [String])

715 -> ExportSettingSetter (Either [String] [String])

src/Text/Pandoc/Readers/Org/ParserState.hs+19−2

@@ -42,6 +42,8 @@ module Text.Pandoc.Readers.Org.ParserState

42 , returnF

43 , ExportSettingSetter

44 , ExportSettings (..)

45+ , ArchivedTreesOption (..)

46+ , setExportArchivedTrees

45 , setExportDrawers

47 , setExportDrawers

46 , setExportEmphasizedText

48 , setExportEmphasizedText

47 , setExportSmartQuotes

49 , setExportSmartQuotes

@@ -78,10 +80,17 @@ type OrgNoteTable = [OrgNoteRecord]

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

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

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

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

83+-- | Options for the way archived trees are handled.

84+data ArchivedTreesOption =

85+ ArchivedTreesExport -- ^ Export the complete tree

86+ | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting

87+ | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents

88+

81-- | Export settings <http://orgmode.org/manual/Export-settings.html>

89-- | Export settings <http://orgmode.org/manual/Export-settings.html>

82-- These settings can be changed via OPTIONS statements.

90-- These settings can be changed via OPTIONS statements.

83data ExportSettings = ExportSettings

91data ExportSettings = ExportSettings

92+ { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees

84− { exportDrawers :: Either [String] [String]

93+ , exportDrawers :: Either [String] [String]

85 -- ^ Specify drawer names which should be exported. @Left@ names are

94 -- ^ Specify drawer names which should be exported. @Left@ names are

86 -- explicitly excluded from the resulting output while @Right@ means that

95 -- explicitly excluded from the resulting output while @Right@ means that

87 -- only the listed drawer names should be included.

96 -- only the listed drawer names should be included.

@@ -159,7 +168,8 @@ defaultOrgParserState = OrgParserState

159

168

160defaultExportSettings :: ExportSettings

169defaultExportSettings :: ExportSettings

161defaultExportSettings = ExportSettings

170defaultExportSettings = ExportSettings

171+ { exportArchivedTrees = ArchivedTreesHeadlineOnly

162− { exportDrawers = Left ["LOGBOOK"]

172+ , exportDrawers = Left ["LOGBOOK"]

163 , exportEmphasizedText = True

173 , exportEmphasizedText = True

164 , exportSmartQuotes = True

174 , exportSmartQuotes = True

165 , exportSpecialStrings = True

175 , exportSpecialStrings = True

@@ -174,8 +184,15 @@ optionsToParserState opts =

174--

184--

175-- Setter for exporting options

185-- Setter for exporting options

176--

186--

187+

188+-- This whole section could be scraped if we were using lenses.

189+

177type ExportSettingSetter a = a -> ExportSettings -> ExportSettings

190type ExportSettingSetter a = a -> ExportSettings -> ExportSettings

178

191

192+-- | Set export options for archived trees.

193+setExportArchivedTrees :: ExportSettingSetter ArchivedTreesOption

194+setExportArchivedTrees val es = es { exportArchivedTrees = val }

195+

179-- | Set export options for drawers. See the @exportDrawers@ in ADT

196-- | Set export options for drawers. See the @exportDrawers@ in ADT

180-- @ExportSettings@ for details.

197-- @ExportSettings@ for details.

181setExportDrawers :: ExportSettingSetter (Either [String] [String])

198setExportDrawers :: ExportSettingSetter (Either [String] [String])

tests/Tests/Readers/Org.hs+24

@@ -587,6 +587,30 @@ tests =

587 , ":END:"

588 ] =?>

589 divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")

590+

591+ , "Export option: don't include archive trees" =:

592+ unlines [ "#+OPTIONS: arch:nil"

593+ , "* old :ARCHIVE:"

594+ ] =?>

595+ (mempty ::Blocks)

596+

597+ , "Export option: include complete archive trees" =:

598+ unlines [ "#+OPTIONS: arch:t"

599+ , "* old :ARCHIVE:"

600+ , " boring"

601+ ] =?>

602+ let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty

603+ in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")

604+ , para "boring"

605+ ]

606+

607+ , "Export option: include archive tree header only" =:

608+ unlines [ "#+OPTIONS: arch:headline"

609+ , "* old :ARCHIVE:"

610+ , " boring"

611+ ] =?>

612+ let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty

613+ in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")

590 ]

614 ]

591

615

592 , testGroup "Basic Blocks" $

616 , testGroup "Basic Blocks" $