From a4717c2fc5d82bc4740b21927ca7db3115a8b1af Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sun, 22 May 2016 22:26:38 +0200
Subject: [PATCH] Org reader: respect drawer export setting
The `d` export option can be used to control which drawers are exported
and which are discarded. Basic support for this option is added here.
---
src/Text/Pandoc/Readers/Org.hs | 76 ++++++++++++++++++----
src/Text/Pandoc/Readers/Org/ParserState.hs | 15 ++++-
tests/Tests/Readers/Org.hs | 25 ++++++-
3 files changed, 103 insertions(+), 13 deletions(-)
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 0ccaa8782..621e7107f 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -138,7 +138,7 @@ exportSetting = choice
, ignoredSetting "author"
, ignoredSetting "c"
, ignoredSetting "creator"
- , ignoredSetting "d"
+ , complementableListSetting "d" setExportDrawers
, ignoredSetting "date"
, ignoredSetting "e"
, ignoredSetting "email"
@@ -164,15 +164,53 @@ booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
booleanSetting settingIdentifier setter = try $ do
string settingIdentifier
char ':'
- value <- many nonspaceChar
- let boolValue = case value of
- "nil" -> False
- "{}" -> False
- _ -> True
- updateState $ modifyExportSettings setter boolValue
+ value <- elispBoolean
+ updateState $ modifyExportSettings setter value
+
+-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are
+-- interpreted as true.
+elispBoolean :: OrgParser Bool
+elispBoolean = try $ do
+ value <- many1 nonspaceChar
+ return $ case map toLower value of
+ "nil" -> False
+ "{}" -> False
+ "()" -> False
+ _ -> True
+
+-- | A list or a complement list (i.e. a list starting with `not`).
+complementableListSetting :: String
+ -> ExportSettingSetter (Either [String] [String])
+ -> OrgParser ()
+complementableListSetting settingIdentifier setter = try $ do
+ _ <- string settingIdentifier <* char ':'
+ value <- choice [ Left <$> complementStringList
+ , Right <$> stringList
+ , (\b -> if b then Left [] else Right []) <$> elispBoolean
+ ]
+ updateState $ modifyExportSettings setter value
+ where
+ -- Read a plain list of strings.
+ stringList :: OrgParser [String]
+ stringList = try $
+ char '('
+ *> sepBy elispString spaces
+ <* char ')'
+
+ -- Read an emacs lisp list specifying a complement set.
+ complementStringList :: OrgParser [String]
+ complementStringList = try $
+ string "(not "
+ *> sepBy elispString spaces
+ <* char ')'
+
+ elispString :: OrgParser String
+ elispString = try $
+ char '"'
+ *> manyTill alphaNum (char '"')
ignoredSetting :: String -> OrgParser ()
-ignoredSetting s = try (() <$ string s <* char ':' <* many nonspaceChar)
+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
--
-- Parser
@@ -588,11 +626,27 @@ exampleLine = try $ skipSpaces *> string ": " *> anyLine
--
-- | A generic drawer which has no special meaning for org-mode.
+-- Whether or not this drawer is included in the output depends on the drawers
+-- export setting.
genericDrawer :: OrgParser (F Blocks)
genericDrawer = try $ do
- drawerStart
- manyTill drawerLine (try drawerEnd)
- return mempty
+ name <- map toUpper <$> drawerStart
+ content <- manyTill drawerLine (try drawerEnd)
+ state <- getState
+ -- Include drawer if it is explicitly included in or not explicitly excluded
+ -- from the list of drawers that should be exported. PROPERTIES drawers are
+ -- never exported.
+ case (exportDrawers . orgStateExportSettings $ state) of
+ _ | name == "PROPERTIES" -> return mempty
+ Left names | name `elem` names -> return mempty
+ Right names | name `notElem` names -> return mempty
+ _ -> drawerDiv name <$> parseLines content
+ where
+ parseLines :: [String] -> OrgParser (F Blocks)
+ parseLines = parseFromString parseBlocks . (++ "\n") . unlines
+
+ drawerDiv :: String -> F Blocks -> F Blocks
+ drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)
drawerStart :: OrgParser String
drawerStart = try $
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index f84e5e51b..6a902cd46 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -39,8 +39,9 @@ module Text.Pandoc.Readers.Org.ParserState
, runF
, returnF
, ExportSettingSetter
- , exportSubSuperscripts
+ , ExportSettings (..)
, setExportSubSuperscripts
+ , setExportDrawers
, modifyExportSettings
) where
@@ -76,6 +77,10 @@ type OrgLinkFormatters = M.Map String (String -> String)
-- These settings can be changed via OPTIONS statements.
data ExportSettings = ExportSettings
{ exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
+ , 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.
}
-- | Org-mode parser state
@@ -155,6 +160,7 @@ defaultOrgParserState = OrgParserState
defaultExportSettings :: ExportSettings
defaultExportSettings = ExportSettings
{ exportSubSuperscripts = True
+ , exportDrawers = Left ["LOGBOOK"]
}
@@ -163,9 +169,16 @@ defaultExportSettings = ExportSettings
--
type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
+-- | Set export options for sub/superscript parsing. The short syntax will
+-- not be parsed if this is set set to @False@.
setExportSubSuperscripts :: ExportSettingSetter Bool
setExportSubSuperscripts val es = es { exportSubSuperscripts = val }
+-- | Set export options for drawers. See the @exportDrawers@ in ADT
+-- @ExportSettings@ for details.
+setExportDrawers :: ExportSettingSetter (Either [String] [String])
+setExportDrawers val es = es { exportDrawers = val }
+
-- | Modify a parser state
modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState
modifyExportSettings setter val state =
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index c478fedd6..780053059 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -420,9 +420,10 @@ tests =
, "Drawers can be arbitrary" =:
unlines [ ":FOO:"
+ , "/bar/"
, ":END:"
] =?>
- (mempty::Blocks)
+ divWith (mempty, ["FOO", "drawer"], mempty) (para $ emph "bar")
, "Anchor reference" =:
unlines [ "<<link-here>> Target."
@@ -475,6 +476,28 @@ tests =
, "a^b"
] =?>
para "a^b"
+
+ , "Export option: directly select drawers to be exported" =:
+ unlines [ "#+OPTIONS: d:(\"IMPORTANT\")"
+ , ":IMPORTANT:"
+ , "23"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23")
+
+ , "Export option: exclude drawers from being exported" =:
+ unlines [ "#+OPTIONS: d:(not \"BORING\")"
+ , ":IMPORTANT:"
+ , "5"
+ , ":END:"
+ , ":BORING:"
+ , "very boring"
+ , ":END:"
+ ] =?>
+ divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5")
]
, testGroup "Basic Blocks" $