From 0622ed11ed45ab35d04503993462a437e7d59cbb Mon Sep 17 00:00:00 2001
From: Tony Zorman <soliditsallgood@mailbox.org>
Date: Tue, 30 Apr 2024 08:25:20 +0200
Subject: [PATCH] X.P.OrgMode: Do not default the day if no time is given

Partially reverts b8d5c391cc03cfa5d7d95caa79f590d366e3c0ba
Fixes: https://github.com/liskin/xmonad-contrib/actions/runs/8869462044/job/24350171604
---
 XMonad/Prompt/OrgMode.hs | 19 ++++++++++++-------
 tests/OrgMode.hs         |  6 ++++--
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs
index 17ae5af61..e325813ac 100644
--- a/XMonad/Prompt/OrgMode.hs
+++ b/XMonad/Prompt/OrgMode.hs
@@ -514,8 +514,8 @@ ppNote clp todo = \case
 -- | Parse the given string into a 'Note'.
 pInput :: String -> Maybe Note
 pInput inp = (`runParser` inp) . choice $
-  [ Scheduled <$> (getLast "+s" <* " ") <*> (Time <$> pDate <*> pOrgTime) <*> pPriority
-  , Deadline  <$> (getLast "+d" <* " ") <*> (Time <$> pDate <*> pOrgTime) <*> pPriority
+  [ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
+  , Deadline  <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
   , do s <- munch1 (pure True)
        let (s', p) = splitAt (length s - 3) s
        pure $ case tryPrio p of
@@ -523,6 +523,12 @@ pInput inp = (`runParser` inp) . choice $
          Nothing   -> NormalMsg s                   NoPriority
   ]
  where
+  fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
+  fixTime d tod = case (d, tod) of
+    (Nothing, Nothing) -> mempty                -- no day and no time
+    (Nothing, Just{})  -> pure (Time Today tod) -- no day, but a time
+    (Just d', _)       -> pure (Time d'    tod) -- day given
+
   tryPrio :: String -> Maybe Priority
   tryPrio [' ', '#', x]
     | x `elem` ("Aa" :: String) = Just A
@@ -588,15 +594,14 @@ pOrgTime = option Nothing $
   pHour   :: Parser Int = pNumBetween 0 23
   pMinute :: Parser Int = pNumBetween 0 59
 
--- | Parse a 'Date'.
-pDate :: Parser Date
-pDate = skipSpaces *> choice
+-- | Try to parse a 'Date'.
+pDate :: Parser (Maybe Date)
+pDate = skipSpaces *> optional (choice
   [ pPrefix "tod" "ay"    Today
   , pPrefix "tom" "orrow" Tomorrow
   , Next <$> pNext
   , Date <$> pDate'
-  , pure Today       -- Fallback to today if no date was given.
-  ]
+  ])
  where
   pNext :: Parser DayOfWeek = choice
     [ pPrefix "m"  "onday"    Monday   , pPrefix "tu" "esday"  Tuesday
diff --git a/tests/OrgMode.hs b/tests/OrgMode.hs
index fa9dc6682..dd6f08719 100644
--- a/tests/OrgMode.hs
+++ b/tests/OrgMode.hs
@@ -61,13 +61,15 @@ spec = do
         `shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)
       pInput "todo +d 14:05 #B"
         `shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)
-    it "parses `blah+d` and `blah +d` as normal messages, but `blah +d ` as a deadline for today" $ do
+    it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do
       pInput "blah+d"
         `shouldBe` Just (NormalMsg "blah+d" NoPriority)
       pInput "blah +d"
         `shouldBe` Just (NormalMsg "blah +d" NoPriority)
       pInput "blah +d "
-        `shouldBe` Just (Deadline "blah" (Time {date = Today, tod = Nothing}) NoPriority)
+        `shouldBe` Just (NormalMsg "blah +d " NoPriority)
+      pInput "blah +d #B"
+        `shouldBe` Just (NormalMsg "blah +d" B)
 
   context "no priority#b" $ do
     it "parses to the correct thing" $