Org reader: strip planning info from output

Planning info is parsed, but not included in the output (as is the
default with Emacs Org-mode).

Fixes: #4867

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"
+    ]
   ]