diff options
| author | Albert Krewinkel <albert@zeitkraut.de> | 2016-07-01 21:17:55 +0200 |
|---|---|---|
| committer | Albert Krewinkel <albert@zeitkraut.de> | 2016-07-01 23:05:32 +0200 |
| commit | 1ebaf6de117d74145a58d63a41a4c69b87aaa771 (patch) | |
| tree | 8e64ea9ec3139cca704783de244e82e0153dc6d8 /src/Text/Pandoc | |
| parent | 17484ed01a7659beddd93114d2ff542005df2465 (diff) | |
| download | pandoc-1ebaf6de117d74145a58d63a41a4c69b87aaa771.tar.gz | |
Org reader: refactor comment tree handling
Comment trees were handled after parsing, as pattern matching on lists
is easier than matching on sequences. The new method of reading
documents as trees allows for more elegant subtree removal.
Diffstat (limited to 'src/Text/Pandoc')
| -rw-r--r-- | src/Text/Pandoc/Readers/Org.hs | 39 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/Blocks.hs | 21 |
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 |