1ebaf6d · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: refactor comment tree handling

1ebaf6dAlbert Krewinkel10 years ago

src/Text/Pandoc/Readers/Org.hs+1−38

compare with master

unifiedsplit

@@ -52,41 +52,4 @@ parseOrg :: OrgParser Pandoc

52parseOrg = do

53 blocks' <- blockList

54 meta' <- meta

55− return . Pandoc meta' $ removeUnwantedBlocks blocks'

55+ return $ Pandoc meta' blocks'

56− where

57− removeUnwantedBlocks :: [Block] -> [Block]

58− removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

59−

60−-- | Drop COMMENT headers and the document tree below those headers.

61−dropCommentTrees :: [Block] -> [Block]

62−dropCommentTrees [] = []

63−dropCommentTrees (b:bs) =

64− maybe (b:dropCommentTrees bs)

65− (dropCommentTrees . flip dropUntilHeaderAboveLevel bs)

66− (commentHeaderLevel b)

67−

68−-- | Return the level of a header starting a comment or :noexport: tree and

69−-- Nothing otherwise.

70−commentHeaderLevel :: Block -> Maybe Int

71−commentHeaderLevel blk =

72− case blk of

73− (Header level _ ((Str "COMMENT"):_)) -> Just level

74− (Header level _ title) | hasNoExportTag title -> Just level

75− _ -> Nothing

76− where

77− hasNoExportTag :: [Inline] -> Bool

78− hasNoExportTag = any isNoExportTag

79−

80− isNoExportTag :: Inline -> Bool

81− isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True

82− isNoExportTag _ = False

83−

84−-- | Drop blocks until a header on or above the given level is seen

85−dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block]

86−dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n)

87−

88−isHeaderLevelLowerEq :: Int -> Block -> Bool

89−isHeaderLevelLowerEq n blk =

90− case blk of

91− (Header level _ _) -> n >= level

92− _ -> False

src/Text/Pandoc/Readers/Org/Blocks.hs+20−1

@@ -1,5 +1,6 @@

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE RecordWildCards #-}

3+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}

3{-

4{-

@@ -52,6 +53,7 @@ import Data.Char ( isSpace, toLower, toUpper)

52import Data.List ( foldl', intersperse, isPrefixOf )

53import Data.List ( foldl', intersperse, isPrefixOf )

53import qualified Data.Map as M

54import qualified Data.Map as M

54import Data.Maybe ( fromMaybe, isNothing )

55import Data.Maybe ( fromMaybe, isNothing )

56+import qualified Data.Sequence as S

55import Network.HTTP ( urlEncode )

57import Network.HTTP ( urlEncode )

57--

59--

@@ -132,7 +134,24 @@ headline lvl = try $ do

132

134

133-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks

135-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks

134headlineToBlocks :: Headline -> OrgParser Blocks

136headlineToBlocks :: Headline -> OrgParser Blocks

135−headlineToBlocks (Headline {..}) = do

137+headlineToBlocks hdln@(Headline {..}) =

138+ case () of

139+ _ | any isNoExportTag headlineTags -> return mempty

140+ _ | isCommentTitle headlineText -> return mempty

141+ _ -> headlineToHeader hdln

142+

143+isNoExportTag :: Tag -> Bool

144+isNoExportTag = (== toTag "noexport")

145+

146+-- | Check if the title starts with COMMENT.

147+-- FIXME: This accesses builder internals not intended for use in situations

148+-- as these. Replace once keyword parsing is supported.

149+isCommentTitle :: Inlines -> Bool

150+isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT"

151+isCommentTitle _ = False

152+

153+headlineToHeader :: Headline -> OrgParser Blocks

154+headlineToHeader (Headline {..}) = do

136 let text = tagTitle headlineText headlineTags

155 let text = tagTitle headlineText headlineTags

137 let propAttr = propertiesToAttr headlineProperties

156 let propAttr = propertiesToAttr headlineProperties

138 attr <- registerHeader propAttr headlineText

157 attr <- registerHeader propAttr headlineText