X.P.OrgMode: Also parse time in HHMM format

CHANGES.md

@@ -116,6 +116,8 @@
     targeted refiling of the entered note into some existing tree of
     headings, respectively.
 
+  - Allowed the time specification in `HHMM` format.
+
 ### Other changes
 
 ## 0.17.1 (September 3, 2022)

XMonad/Prompt/OrgMode.hs

@@ -115,8 +115,8 @@ troubles.  Weekdays always schedule into the future; e.g., if today is
 Monday and you schedule something for Monday, you will actually schedule
 it for the /next/ Monday (the one in seven days).
 
-The time is specified in the @HH:MM@ format.  The minutes may be
+The time is specified in the @HH:MM@ or @HHMM@ format.  The minutes may
-omitted, in which case we assume a full hour is specified.
+be omitted, in which case we assume a full hour is specified.
 
 A few examples are probably in order.  Suppose we have bound the key
 above, pressed it, and are now confronted with a prompt:
@@ -532,13 +532,22 @@ pPriority = option NoPriority $
 -- | Try to parse a 'Time'.
 pTimeOfDay :: Parser (Maybe TimeOfDay)
 pTimeOfDay = option Nothing $
-  skipSpaces *> choice
+  skipSpaces >> Just <$> choice
-    [ Just <$> (TimeOfDay <$> pHour <* ":" <*> pMinute) -- HH:MM
+    [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM
-    , Just <$> (TimeOfDay <$> pHour        <*> pure 0 ) -- HH
+    , pHHMM                                  -- HHMM
+    , TimeOfDay <$> pHour        <*> pure 0  -- HH
     ]
  where
-  pMinute :: Parser Int = pNumBetween 0 59
+  pHHMM :: Parser TimeOfDay
+  pHHMM = do
+    let getTwo = count 2 (satisfy isDigit)
+    hh <- read <$> getTwo
+    guard (hh >= 0 && hh <= 23)
+    mm <- read <$> getTwo
+    guard (mm >= 0 && mm <= 59)
+    pure $ TimeOfDay hh mm
   pHour   :: Parser Int = pNumBetween 0 23
+  pMinute :: Parser Int = pNumBetween 0 59
 
 -- | Parse a 'Date'.
 pDate :: Parser Date

tests/OrgMode.hs

@@ -150,6 +150,7 @@ instance Arbitrary OrgMsg where
     hourGen :: Gen String
     hourGen = oneof
       [ pure " " <<>> (pad <$> hourInt) <<>> pure ":" <<>> (pad <$> minuteInt)
+      , pure " " <<>> (pad <$> hourInt) <<>>               (pad <$> minuteInt)
       , pure ""
       ]
      where