aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Org.hs39
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs21
2 files changed, 21 insertions, 39 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index d593f856d..4e1c926da 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -52,41 +52,4 @@ parseOrg :: OrgParser Pandoc
parseOrg = do
blocks' <- blockList
meta' <- meta
- return . Pandoc meta' $ removeUnwantedBlocks blocks'
- where
- removeUnwantedBlocks :: [Block] -> [Block]
- removeUnwantedBlocks = dropCommentTrees . filter (/= Null)
-
--- | Drop COMMENT headers and the document tree below those headers.
-dropCommentTrees :: [Block] -> [Block]
-dropCommentTrees [] = []
-dropCommentTrees (b:bs) =
- maybe (b:dropCommentTrees bs)
- (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)
- (commentHeaderLevel b)
-
--- | Return the level of a header starting a comment or :noexport: tree and
--- Nothing otherwise.
-commentHeaderLevel :: Block -> Maybe Int
-commentHeaderLevel blk =
- case blk of
- (Header level _ ((Str "COMMENT"):_)) -> Just level
- (Header level _ title) | hasNoExportTag title -> Just level
- _ -> Nothing
- where
- hasNoExportTag :: [Inline] -> Bool
- hasNoExportTag = any isNoExportTag
-
- isNoExportTag :: Inline -> Bool
- isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True
- isNoExportTag _ = False
-
--- | 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
+ return $ Pandoc meta' blocks'
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 9ebb22d13..c9e9d2ced 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
{-
Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
@@ -52,6 +53,7 @@ import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isNothing )
+import qualified Data.Sequence as S
import Network.HTTP ( urlEncode )
--
@@ -132,7 +134,24 @@ headline lvl = try $ do
-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
headlineToBlocks :: Headline -> OrgParser Blocks
-headlineToBlocks (Headline {..}) = do
+headlineToBlocks hdln@(Headline {..}) =
+ case () of
+ _ | any isNoExportTag headlineTags -> return mempty
+ _ | isCommentTitle headlineText -> return mempty
+ _ -> headlineToHeader hdln
+
+isNoExportTag :: Tag -> Bool
+isNoExportTag = (== toTag "noexport")
+
+-- | 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.
+isCommentTitle :: Inlines -> Bool
+isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"
+isCommentTitle _ = False
+
+headlineToHeader :: Headline -> OrgParser Blocks
+headlineToHeader (Headline {..}) = do
let text = tagTitle headlineText headlineTags
let propAttr = propertiesToAttr headlineProperties
attr <- registerHeader propAttr headlineText