Org reader: Add partial support for `#+EXCLUDE_TAGS` option. (#4950)

Closes #4284.

Headers with the corresponding tags should not appear in the output.

If one or more of the specified tags contains a non-tag character
like `+`, Org-mode will not treat that as a valid tag, but will
nonetheless continue scanning for valid tags. That behavior is not
replicated in this patch; entering `cat+dog` as one of the entries in
`#+EXCLUDE_TAGS` and running the file through Pandoc will cause the
parser to fail and result in the only excluded tag being the default, `noexport`.

1 files changed, 7 insertions, 7 deletions

diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index a9df3b437..7d55892fe 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -43,6 +43,7 @@ import Text.Pandoc.Readers.Org.BlockStarts
 import Text.Pandoc.Readers.Org.ParserState
 import Text.Pandoc.Readers.Org.Parsing
 
+import qualified Data.Set as Set
 import qualified Text.Pandoc.Builder as B
 
 --
@@ -73,9 +74,6 @@ documentTree blocks inline = do
       , headlineChildren = headlines'
       }
 
-newtype Tag = Tag { fromTag :: String }
-  deriving (Show, Eq)
-
 -- | Create a tag containing the given string.
 toTag :: String -> Tag
 toTag = Tag
@@ -153,7 +151,7 @@ headline blocks inline lvl = try $ do
 
    headerTags :: Monad m => OrgParser m [Tag]
    headerTags = try $
-     let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
+     let tag = orgTagWord <* char ':'
      in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)
 
 -- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
@@ -163,15 +161,17 @@ headlineToBlocks hdln = do
   let tags = headlineTags hdln
   let text = headlineText hdln
   let level = headlineLevel hdln
+  shouldNotExport <- hasDoNotExportTag tags
   case () of
-    _ | any isNoExportTag tags -> return mempty
+    _ | shouldNotExport -> return mempty
     _ | any isArchiveTag  tags -> archivedHeadlineToBlocks hdln
     _ | isCommentTitle text    -> return mempty
     _ | maxLevel <= level      -> headlineToHeaderWithList hdln
     _ | otherwise              -> headlineToHeaderWithContents hdln
 
-isNoExportTag :: Tag -> Bool
-isNoExportTag = (== toTag "noexport")
+hasDoNotExportTag :: Monad m => [Tag] -> OrgParser m Bool
+hasDoNotExportTag tags = containsExcludedTag . orgStateExcludedTags <$> getState
+  where containsExcludedTag s = any (`Set.member` s) tags
 
 isArchiveTag :: Tag -> Bool
 isArchiveTag = (== toTag "ARCHIVE")