Merge pull request #1702 from tarleb/org-comment-trees

Org reader: Drop COMMENT document trees

2 files changed, 38 insertions, 1 deletions

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 5c00a1b27..483f49905 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -69,7 +69,32 @@ parseOrg = do
   blocks' <- parseBlocks
   st <- getState
   let meta = runF (orgStateMeta' st) st
-  return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st)
+  let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
+  return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)
+
+-- | Drop COMMENT headers and the document tree below those headers.
+dropCommentTrees :: [Block] -> [Block]
+dropCommentTrees [] = []
+dropCommentTrees blks@(b:bs) =
+  maybe blks (flip dropUntilHeaderAboveLevel bs) $ commentHeaderLevel b
+
+-- | Return the level of a header starting a comment tree and Nothing
+-- otherwise.
+commentHeaderLevel :: Block -> Maybe Int
+commentHeaderLevel blk =
+   case blk of
+     (Header level _ ((Str "COMMENT"):_)) -> Just level
+     _                                    -> Nothing
+
+-- | Drop blocks until a header on or above the given level is seen
+dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]
+dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)
+
+isHeaderLevelLowerEq :: Int -> Block -> Bool
+isHeaderLevelLowerEq n blk =
+  case blk of
+    (Header level _ _) -> n >= level
+    _                  -> False
 
 --
 -- Parser State for Org
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 92ec8155b..b37825ad5 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -450,6 +450,18 @@ tests =
                   , header 2 ("walk" <> space <> "dog")
                   ]
 
+      , "Comment Trees" =:
+          unlines [ "* COMMENT A comment tree"
+                  , "  Not much going on here"
+                  , "** This will be dropped"
+                  , "* Comment tree above"
+                  ] =?>
+          header 1 "Comment tree above"
+
+      , "Nothing but a COMMENT header" =:
+          "* COMMENT Test" =?>
+          (mempty::Blocks)
+
       , "Paragraph starting with an asterisk" =:
           "*five" =?>
           para "*five"