ac83b9c · typeable/pandoc

git.iko.soy/typeable/pandoc

Org reader: add support for #+SELECT_TAGS.

commitac83b9c37c39a49878e7d864fb276c0e4caed338 authorleungbk <bkleung89@gmail.com> dateSun 27 Jan 2019, 22:22 (8 years ago) parentdc43174

8 files changed+107−23

compare with master

unifiedsplit

pandoc.cabal+1 src/Text/Pandoc/Readers/Org/Blocks.hs+4−5 src/Text/Pandoc/Readers/Org/DocumentTree.hs+50−6 src/Text/Pandoc/Readers/Org/Meta.hs+16−8 src/Text/Pandoc/Readers/Org/ParserState.hs+8−4 test/Tests/Old.hs+4 test/org-select-tags.native+7 test/org-select-tags.org+17

pandoc.cabal+1

@@ -208,6 +208,7 @@ extra-source-files:

208208 test/docbook-xref.docbook

209209 test/html-reader.html

210210 test/opml-reader.opml

211+ test/org-select-tags.org

211212 test/haddock-reader.haddock

212213 test/insert

213214 test/lalune.jpg

src/Text/Pandoc/Readers/Org/Blocks.hs+4−5

@@ -34,7 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks

3434

3535import Prelude

3636import Text.Pandoc.Readers.Org.BlockStarts

37−import Text.Pandoc.Readers.Org.DocumentTree (documentTree, headlineToBlocks, filterHeadlineTree)

37+import Text.Pandoc.Readers.Org.DocumentTree (documentTree,

38+ unprunedHeadlineToBlocks)

3839import Text.Pandoc.Readers.Org.Inlines

3940import Text.Pandoc.Readers.Org.Meta (metaExport, metaKey, metaLine)

4041import Text.Pandoc.Readers.Org.ParserState

@@ -64,12 +65,10 @@ import qualified Text.Pandoc.Walk as Walk

6465-- | Get a list of blocks.

6566blockList :: PandocMonad m => OrgParser m [Block]

6667blockList = do

67− fHeadlineTree <- documentTree blocks inline

68+ fHeadlineTree <- documentTree blocks inline

6869 st <- getState

6970 let headlineTree = runF fHeadlineTree st

70− headlineBlocks <- headlineToBlocks $ filterHeadlineTree headlineTree st

71− -- ignore first headline, it's the document's title

72− return . drop 1 . B.toList $ headlineBlocks

71+ unprunedHeadlineToBlocks headlineTree st

7372

7473-- | Get the meta information saved in the state.

7574meta :: Monad m => OrgParser m Meta

src/Text/Pandoc/Readers/Org/DocumentTree.hs+50−6

@@ -28,8 +28,7 @@ Parsers for org-mode headlines and document subtrees

2828-}

2929module Text.Pandoc.Readers.Org.DocumentTree

3030 ( documentTree

31− , headlineToBlocks

32− , filterHeadlineTree

31+ , unprunedHeadlineToBlocks

3332 ) where

3433

3534import Prelude

@@ -37,6 +36,7 @@ import Control.Arrow ((***))

3736import Control.Monad (guard, void)

3837import Data.Char (toLower, toUpper)

3938import Data.List (intersperse)

39+import Data.Maybe (mapMaybe)

4040import Text.Pandoc.Builder (Blocks, Inlines)

4141import Text.Pandoc.Class (PandocMonad)

4242import Text.Pandoc.Definition

@@ -155,6 +155,22 @@ headline blocks inline lvl = try $ do

155155 let tag = orgTagWord <* char ':'

156156 in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)

157157

158+unprunedHeadlineToBlocks :: Monad m => Headline -> OrgParserState -> OrgParser m [Block]

159+unprunedHeadlineToBlocks hdln st =

160+ let usingSelectedTags = docContainsSelectTags hdln st

161+ rootNode = if not usingSelectedTags

162+ then hdln

163+ else includeRootAndSelected hdln st

164+ rootNode' = removeExplicitlyExcludedNodes rootNode st

165+ in if not usingSelectedTags ||

166+ any (`Set.member` orgStateSelectTags st) (headlineTags rootNode')

167+ then do headlineBlocks <- headlineToBlocks rootNode'

168+ -- ignore first headline, it's the document's title

169+ return . drop 1 . B.toList $ headlineBlocks

170+ else do headlineBlocks <- mconcat <$> mapM headlineToBlocks

171+ (headlineChildren rootNode')

172+ return . B.toList $ headlineBlocks

173+

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

159175headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks

160176headlineToBlocks hdln = do

@@ -168,12 +184,40 @@ headlineToBlocks hdln = do

168184 _ | maxLevel <= level -> headlineToHeaderWithList hdln

169185 _ | otherwise -> headlineToHeaderWithContents hdln

170186

171−filterHeadlineTree :: Headline -> OrgParserState -> Headline

172−filterHeadlineTree hdln st =

187+removeExplicitlyExcludedNodes :: Headline -> OrgParserState -> Headline

188+removeExplicitlyExcludedNodes hdln st =

173189 hdln { headlineChildren =

174− [filterHeadlineTree childHdln st |

190+ [removeExplicitlyExcludedNodes childHdln st |

175191 childHdln <- headlineChildren hdln,

176− not $ any (`Set.member` orgStateExcludedTags st) (headlineTags childHdln)] }

192+ not $ headlineContainsExcludeTags childHdln st] }

193+

194+includeRootAndSelected :: Headline -> OrgParserState -> Headline

195+includeRootAndSelected hdln st =

196+ hdln { headlineChildren = mapMaybe (`includeAncestorsAndSelected` st)

197+ (headlineChildren hdln)}

198+

199+docContainsSelectTags :: Headline -> OrgParserState -> Bool

200+docContainsSelectTags hdln st =

201+ headlineContainsSelectTags hdln st ||

202+ any (`docContainsSelectTags` st) (headlineChildren hdln)

203+

204+includeAncestorsAndSelected :: Headline -> OrgParserState -> Maybe Headline

205+includeAncestorsAndSelected hdln st =

206+ if headlineContainsSelectTags hdln st

207+ then Just hdln

208+ else let children = mapMaybe (`includeAncestorsAndSelected` st)

209+ (headlineChildren hdln)

210+ in case children of

211+ [] -> Nothing

212+ _ -> Just $ hdln { headlineChildren = children }

213+

214+headlineContainsSelectTags :: Headline -> OrgParserState -> Bool

215+headlineContainsSelectTags hdln st =

216+ any (`Set.member` orgStateSelectTags st) (headlineTags hdln)

217+

218+headlineContainsExcludeTags :: Headline -> OrgParserState -> Bool

219+headlineContainsExcludeTags hdln st =

220+ any (`Set.member` orgStateExcludeTags st) (headlineTags hdln)

177221

178222isArchiveTag :: Tag -> Bool

179223isArchiveTag = (== toTag "ARCHIVE")

src/Text/Pandoc/Readers/Org/Meta.hs+16−8

@@ -159,7 +159,8 @@ optionLine = try $ do

159159 "seq_todo" -> todoSequence >>= updateState . registerTodoSequence

160160 "typ_todo" -> todoSequence >>= updateState . registerTodoSequence

161161 "macro" -> macroDefinition >>= updateState . registerMacro

162− "exclude_tags" -> excludedTagList >>= updateState . setExcludedTags

162+ "exclude_tags" -> tagList >>= updateState . setExcludedTags

163+ "select_tags" -> tagList >>= updateState . setSelectedTags

163164 "pandoc-emphasis-pre" -> emphChars >>= updateState . setEmphasisPreChar

164165 "pandoc-emphasis-post" -> emphChars >>= updateState . setEmphasisPostChar

165166 _ -> mzero

@@ -192,17 +193,24 @@ parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend

192193 rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")

193194 tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))

194195

195−excludedTagList :: Monad m => OrgParser m [Tag]

196−excludedTagList = do

196+tagList :: Monad m => OrgParser m [Tag]

197+tagList = do

197198 skipSpaces

198199 map Tag <$> many (orgTagWord <* skipSpaces) <* newline

199200

200201setExcludedTags :: [Tag] -> OrgParserState -> OrgParserState

201−setExcludedTags tagList st =

202− let finalSet = if orgStateExcludedTagsChanged st

203− then foldr Set.insert (orgStateExcludedTags st) tagList

204− else Set.fromList tagList

205− in st { orgStateExcludedTags = finalSet, orgStateExcludedTagsChanged = True }

202+setExcludedTags tags st =

203+ let finalSet = if orgStateExcludeTagsChanged st

204+ then foldr Set.insert (orgStateExcludeTags st) tags

205+ else Set.fromList tags

206+ in st { orgStateExcludeTags = finalSet, orgStateExcludeTagsChanged = True }

207+

208+setSelectedTags :: [Tag] -> OrgParserState -> OrgParserState

209+setSelectedTags tags st =

210+ let finalSet = if orgStateSelectTagsChanged st

211+ then foldr Set.insert (orgStateSelectTags st) tags

212+ else Set.fromList tags

213+ in st { orgStateSelectTags = finalSet, orgStateSelectTagsChanged = True }

206214

207215setEmphasisPreChar :: Maybe [Char] -> OrgParserState -> OrgParserState

208216setEmphasisPreChar csMb st =

src/Text/Pandoc/Readers/Org/ParserState.hs+8−4

@@ -117,8 +117,8 @@ data OrgParserState = OrgParserState

117117 -- specified here.

118118 , orgStateEmphasisPostChars :: [Char] -- ^ Chars allowed at after emphasis

119119 , orgStateEmphasisNewlines :: Maybe Int

120− , orgStateExcludedTags :: Set.Set Tag

121− , orgStateExcludedTagsChanged :: Bool

120+ , orgStateExcludeTags :: Set.Set Tag

121+ , orgStateExcludeTagsChanged :: Bool

122122 , orgStateExportSettings :: ExportSettings

123123 , orgStateIdentifiers :: Set.Set String

124124 , orgStateIncludeFiles :: [String]

@@ -132,6 +132,8 @@ data OrgParserState = OrgParserState

132132 , orgStateNotes' :: OrgNoteTable

133133 , orgStateOptions :: ReaderOptions

134134 , orgStateParserContext :: ParserContext

135+ , orgStateSelectTags :: Set.Set Tag

136+ , orgStateSelectTagsChanged :: Bool

135137 , orgStateTodoSequences :: [TodoSequence]

136138 , orgLogMessages :: [LogMessage]

137139 , orgMacros :: M.Map Text Macro

@@ -184,8 +186,8 @@ defaultOrgParserState = OrgParserState

184186 , orgStateEmphasisCharStack = []

185187 , orgStateEmphasisNewlines = Nothing

186188 , orgStateExportSettings = def

187− , orgStateExcludedTags = Set.singleton $ Tag "noexport"

188− , orgStateExcludedTagsChanged = False

189+ , orgStateExcludeTags = Set.singleton $ Tag "noexport"

190+ , orgStateExcludeTagsChanged = False

189191 , orgStateIdentifiers = Set.empty

190192 , orgStateIncludeFiles = []

191193 , orgStateLastForbiddenCharPos = Nothing

@@ -198,6 +200,8 @@ defaultOrgParserState = OrgParserState

198200 , orgStateNotes' = []

199201 , orgStateOptions = def

200202 , orgStateParserContext = NullState

203+ , orgStateSelectTags = Set.singleton $ Tag "export"

204+ , orgStateSelectTagsChanged = False

201205 , orgStateTodoSequences = []

202206 , orgLogMessages = []

203207 , orgMacros = M.empty

test/Tests/Old.hs+4

@@ -175,6 +175,10 @@ tests = [ testGroup "markdown"

175175 [ test "reader" ["-r", "man", "-w", "native", "-s"]

176176 "man-reader.man" "man-reader.native"

177177 ]

178+ , testGroup "org"

179+ [ test "reader" ["-r", "org", "-w", "native", "-s"]

180+ "org-select-tags.org" "org-select-tags.native"

181+ ]

178182 ]

179183

180184-- makes sure file is fully closed after reading

test/org-select-tags.nativenew file+7

@@ -0,0 +1,7 @@

1+Pandoc (Meta {unMeta = fromList []})

2+[Header 1 ("will-appear-because-it-is-the-ancestor-of-something-tagged-yes",[],[]) [Str "Will",Space,Str "appear",Space,Str "because",Space,Str "it",Space,Str "is",Space,Str "the",Space,Str "ancestor",Space,Str "of",Space,Str "something",Space,Str "tagged",Space,Str "\"yes\""]

3+,Header 2 ("will-appear",[],[]) [Str "Will",Space,Str "appear",Space,Span ("",["tag"],[("tag-name","yes")]) [SmallCaps [Str "yes"]]]

4+,Header 3 ("will-appear-since-the-entire-subtree-of-something-selected-will-appear",[],[]) [Str "Will",Space,Str "appear",Space,Str "since",Space,Str "the",Space,Str "entire",Space,Str "subtree",Space,Str "of",Space,Str "something",Space,Str "selected",Space,Str "will",Space,Str "appear"]

5+,OrderedList (1,DefaultStyle,DefaultDelim)

6+ [[Para [Str "Will",Space,Str "appear"]]]

7+,Header 2 ("will-appear-because-it-is-the-ancestor-of-something-listed-in-select-tags",[],[]) [Str "Will",Space,Str "appear",Space,Str "because",Space,Str "it",Space,Str "is",Space,Str "the",Space,Str "ancestor",Space,Str "of",Space,Str "something",Space,Str "listed",Space,Str "in",Space,Str "SELECT-TAGS"]]

test/org-select-tags.orgnew file+17

@@ -0,0 +1,17 @@

1+#+SELECT_TAGS: yes no

2+#+EXCLUDE_TAGS: no

4+In a document containing one or more trees containing a tag

5+listed in SELECT_TAGS, only those trees and their ancestor nodes will appear;

6+this text and any other text preceding the first headline

7+won't appear for such documents.

9+* Will appear because it is the ancestor of something tagged "yes"

10+** Will appear :yes:

11+*** Will appear since the entire subtree of something selected will appear

12+**** Will appear

13+*** Will not appear since this has tagged with something in EXCLUDE-TAGS :no:

14+** Will not appear since it's not an ancestor of listed in SELECT-TAGS

15+** Will appear because it is the ancestor of something listed in SELECT-TAGS

16+*** Will not appear because it has an EXCLUDE-TAG, but since "no" is also listed as a SELECT-TAG, it will force its parent to appear :no:

17+* Will not appear