aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2016-07-01 22:44:29 +0200
committerAlbert Krewinkel <albert@zeitkraut.de>2016-07-01 23:05:33 +0200
commitc4cf6d237f1017d36eeafad162570754506a6093 (patch)
treeb760ff99e162aed5a5e4892c7c53098f971cd8cc /src/Text/Pandoc/Readers
parent1ebaf6de117d74145a58d63a41a4c69b87aaa771 (diff)
downloadpandoc-c4cf6d237f1017d36eeafad162570754506a6093.tar.gz
Org reader: support archived trees export options
Handling of archived trees can be modified using the `arch` option. Archived trees are either dropped, exported completely, or collapsed to include just the header when the `arch` option is nil, non-nil, or `headline`, respectively.
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs49
-rw-r--r--src/Text/Pandoc/Readers/Org/ParserState.hs21
2 files changed, 62 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index c9e9d2ced..5d4a0cae2 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -137,27 +137,43 @@ headlineToBlocks :: Headline -> OrgParser Blocks
headlineToBlocks hdln@(Headline {..}) =
case () of
_ | any isNoExportTag headlineTags -> return mempty
+ _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln
_ | isCommentTitle headlineText -> return mempty
- _ -> headlineToHeader hdln
+ _ -> headlineToHeaderWithContents hdln
isNoExportTag :: Tag -> Bool
isNoExportTag = (== toTag "noexport")
+isArchiveTag :: Tag -> Bool
+isArchiveTag = (== toTag "ARCHIVE")
+
-- | Check if the title starts with COMMENT.
-- FIXME: This accesses builder internals not intended for use in situations
--- as these. Replace once keyword parsing is supported.
+-- like these. Replace once keyword parsing is supported.
isCommentTitle :: Inlines -> Bool
isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"
isCommentTitle _ = False
+archivedHeadlineToBlocks :: Headline -> OrgParser Blocks
+archivedHeadlineToBlocks hdln = do
+ archivedTreesOption <- getExportSetting exportArchivedTrees
+ case archivedTreesOption of
+ ArchivedTreesNoExport -> return mempty
+ ArchivedTreesExport -> headlineToHeaderWithContents hdln
+ ArchivedTreesHeadlineOnly -> headlineToHeader hdln
+
+headlineToHeaderWithContents :: Headline -> OrgParser Blocks
+headlineToHeaderWithContents hdln@(Headline {..}) = do
+ header <- headlineToHeader hdln
+ childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
+ return $ header <> headlineContents <> childrenBlocks
+
headlineToHeader :: Headline -> OrgParser Blocks
headlineToHeader (Headline {..}) = do
let text = tagTitle headlineText headlineTags
let propAttr = propertiesToAttr headlineProperties
attr <- registerHeader propAttr headlineText
- let header = B.headerWith attr headlineLevel text
- childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
- return $ header <> headlineContents <> childrenBlocks
+ return $ B.headerWith attr headlineLevel text
propertiesToAttr :: Properties -> Attr
propertiesToAttr properties =
@@ -629,7 +645,7 @@ exportSetting = choice
, ignoredSetting ":"
, ignoredSetting "<"
, ignoredSetting "\\n"
- , ignoredSetting "arch"
+ , archivedTreeSetting "arch" setExportArchivedTrees
, ignoredSetting "author"
, ignoredSetting "c"
, ignoredSetting "creator"
@@ -673,6 +689,27 @@ elispBoolean = try $ do
"()" -> False
_ -> True
+archivedTreeSetting :: String
+ -> ExportSettingSetter ArchivedTreesOption
+ -> OrgParser ()
+archivedTreeSetting settingIdentifier setter = try $ do
+ string settingIdentifier
+ char ':'
+ value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean
+ updateState $ modifyExportSettings setter value
+ where
+ archivedTreesHeadlineSetting = try $ do
+ string "headline"
+ lookAhead (newline <|> spaceChar)
+ return ArchivedTreesHeadlineOnly
+
+ archivedTreesBoolean = try $ do
+ exportBool <- elispBoolean
+ return $
+ if exportBool
+ then ArchivedTreesExport
+ else ArchivedTreesNoExport
+
-- | A list or a complement list (i.e. a list starting with `not`).
complementableListSetting :: String
-> ExportSettingSetter (Either [String] [String])
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 0c58183f9..93be92ae8 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -42,6 +42,8 @@ module Text.Pandoc.Readers.Org.ParserState
, returnF
, ExportSettingSetter
, ExportSettings (..)
+ , ArchivedTreesOption (..)
+ , setExportArchivedTrees
, setExportDrawers
, setExportEmphasizedText
, setExportSmartQuotes
@@ -78,10 +80,17 @@ type OrgNoteTable = [OrgNoteRecord]
-- link-type, the corresponding function transforms the given link string.
type OrgLinkFormatters = M.Map String (String -> String)
+-- | Options for the way archived trees are handled.
+data ArchivedTreesOption =
+ ArchivedTreesExport -- ^ Export the complete tree
+ | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting
+ | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents
+
-- | Export settings <http://orgmode.org/manual/Export-settings.html>
-- These settings can be changed via OPTIONS statements.
data ExportSettings = ExportSettings
- { exportDrawers :: Either [String] [String]
+ { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees
+ , exportDrawers :: Either [String] [String]
-- ^ Specify drawer names which should be exported. @Left@ names are
-- explicitly excluded from the resulting output while @Right@ means that
-- only the listed drawer names should be included.
@@ -159,7 +168,8 @@ defaultOrgParserState = OrgParserState
defaultExportSettings :: ExportSettings
defaultExportSettings = ExportSettings
- { exportDrawers = Left ["LOGBOOK"]
+ { exportArchivedTrees = ArchivedTreesHeadlineOnly
+ , exportDrawers = Left ["LOGBOOK"]
, exportEmphasizedText = True
, exportSmartQuotes = True
, exportSpecialStrings = True
@@ -174,8 +184,15 @@ optionsToParserState opts =
--
-- Setter for exporting options
--
+
+-- This whole section could be scraped if we were using lenses.
+
type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
+-- | Set export options for archived trees.
+setExportArchivedTrees :: ExportSettingSetter ArchivedTreesOption
+setExportArchivedTrees val es = es { exportArchivedTrees = val }
+
-- | Set export options for drawers. See the @exportDrawers@ in ADT
-- @ExportSettings@ for details.
setExportDrawers :: ExportSettingSetter (Either [String] [String])