diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/DocumentTree.hs | 36 | ||||
| -rw-r--r-- | test/Tests/Readers/Org/Block/Header.hs | 25 |
2 files changed, 60 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index c9465581a..8e2f080f2 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -70,6 +70,7 @@ documentTree blocks inline = do , headlineTodoMarker = Nothing , headlineText = B.fromList title' , headlineTags = mempty + , headlinePlanning = emptyPlanning , headlineProperties = mempty , headlineContents = initialBlocks' , headlineChildren = headlines' @@ -117,6 +118,7 @@ data Headline = Headline , headlineTodoMarker :: Maybe TodoMarker , headlineText :: Inlines , headlineTags :: [Tag] + , headlinePlanning :: PlanningInfo -- ^ subtree planning information , headlineProperties :: Properties , headlineContents :: Blocks , headlineChildren :: [Headline] @@ -136,6 +138,7 @@ headline blocks inline lvl = try $ do title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle tags <- option [] headerTags newline + planning <- option emptyPlanning planningInfo properties <- option mempty propertiesDrawer contents <- blocks children <- many (headline blocks inline (level + 1)) @@ -148,6 +151,7 @@ headline blocks inline lvl = try $ do , headlineTodoMarker = todoKw , headlineText = title' , headlineTags = tags + , headlinePlanning = planning , headlineProperties = properties , headlineContents = contents' , headlineChildren = children' @@ -277,9 +281,39 @@ tagsToInlines tags = tagSpan :: Tag -> Inlines -> Inlines tagSpan t = B.spanWith ("", ["tag"], [("tag-name", fromTag t)]) +-- | An Org timestamp, including repetition marks. TODO: improve +type Timestamp = String + +timestamp :: Monad m => OrgParser m Timestamp +timestamp = try $ do + openChar <- oneOf "<[" + let isActive = openChar == '<' + let closeChar = if isActive then '>' else ']' + content <- many1Till anyChar (char closeChar) + return (openChar : content ++ [closeChar]) + +-- | Planning information for a subtree/headline. +data PlanningInfo = PlanningInfo + { planningClosed :: Maybe Timestamp + , planningDeadline :: Maybe Timestamp + , planningScheduled :: Maybe Timestamp + } +emptyPlanning :: PlanningInfo +emptyPlanning = PlanningInfo Nothing Nothing Nothing - +-- | Read a single planning-related and timestamped line. +planningInfo :: Monad m => OrgParser m PlanningInfo +planningInfo = try $ do + updaters <- many1 planningDatum <* skipSpaces <* newline + return $ foldr ($) emptyPlanning updaters + where + planningDatum = skipSpaces *> choice + [ updateWith (\s p -> p { planningScheduled = Just s}) "SCHEDULED" + , updateWith (\d p -> p { planningDeadline = Just d}) "DEADLINE" + , updateWith (\c p -> p { planningClosed = Just c}) "CLOSED" + ] + updateWith fn cs = fn <$> (string cs *> char ':' *> skipSpaces *> timestamp) -- | Read a :PROPERTIES: drawer and return the key/value pairs contained -- within. diff --git a/test/Tests/Readers/Org/Block/Header.hs b/test/Tests/Readers/Org/Block/Header.hs index 3b0d7dda9..6f38714cd 100644 --- a/test/Tests/Readers/Org/Block/Header.hs +++ b/test/Tests/Readers/Org/Block/Header.hs @@ -181,4 +181,29 @@ tests = , " :END:" ] =?> headerWith ("not-numbered", ["unnumbered"], []) 1 "Not numbered" + + , testGroup "planning information" + [ "Planning info is not included in output" =: + T.unlines [ "* important" + , T.unwords + [ "CLOSED: [2018-09-05 Wed 13:58]" + , "DEADLINE: <2018-09-17 Mon>" + , "SCHEDULED: <2018-09-10 Mon>" + ] + ] =?> + headerWith ("important", [], []) 1 "important" + + , "Properties after planning info are recognized" =: + T.unlines [ "* important " + , " " <> T.unwords + [ "CLOSED: [2018-09-05 Wed 13:58]" + , "DEADLINE: <2018-09-17 Mon>" + , "SCHEDULED: <2018-09-10 Mon>" + ] + , " :PROPERTIES:" + , " :custom_id: look" + , " :END:" + ] =?> + headerWith ("look", [], []) 1 "important" + ] ] |