Skip to content

Commit

Permalink
X.P.OrgMode: Do not default the day if no time is given
Browse files Browse the repository at this point in the history
Partially reverts b8d5c391cc03cfa5d7d95caa79f590d366e3c0ba
Fixes: https://github.com/liskin/xmonad-contrib/actions/runs/8869462044/job/24350171604
  • Loading branch information
slotThe committed Apr 30, 2024
1 parent 700507f commit 0622ed1
Show file tree
Hide file tree
Showing 2 changed files with 16 additions and 9 deletions.
19 changes: 12 additions & 7 deletions XMonad/Prompt/OrgMode.hs
Expand Up @@ -514,15 +514,21 @@ 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
Just prio -> NormalMsg (dropStripEnd 0 s') prio
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
Expand Down Expand Up @@ -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
Expand Down
6 changes: 4 additions & 2 deletions tests/OrgMode.hs
Expand Up @@ -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" $
Expand Down

2 comments on commit 0622ed1

@liskin
Copy link
Member

@liskin liskin commented on 0622ed1 Apr 30, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's no b8d5c391cc03cfa5d7d95caa79f590d366e3c0ba commit in xmonad-contrib though…

@slotThe
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, this must've been the hash of that commit with my flake commit still cherry-picked… :) No pushing to master before coffee, got it

Please sign in to comment.