aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Org/DocumentTree.hs36
-rw-r--r--test/Tests/Readers/Org/Block/Header.hs25
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"
+ ]
]