twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-18 19:10:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #883 from slotThe/orgmode-time

Browse Source 
X.P.OrgMode: Add time spans
This commit is contained in:
Tony Zorman 2024-03-31 09:37:24 +02:00 committed by GitHub
commit 51926854d9
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 72 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGES.md
View File

@ -14,10 +14,10 @@
`X StatusBarConfig` values.
### New Modules
* `XMonad.Actions.Profiles`.
- Group workspaces by similarity. Usefull when one has lots
- Group workspaces by similarity. Useful when one has lots
of workspaces and uses only a couple per unit of work.
### Bug Fixes and Minor Changes
@ -33,6 +33,10 @@
- Added `isNotification` predicate to check for windows with
`_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.
* `XMonad.Prompt.OrgMode`
- Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.
### Other changes
## 0.18.0 (February 3, 2024)

64
XMonad/Prompt/OrgMode.hs
View File

@ -53,6 +53,7 @@ module XMonad.Prompt.OrgMode (
Date (..),
Time (..),
TimeOfDay (..),
OrgTime (..),
DayOfWeek (..),
#endif
@ -122,7 +123,9 @@ 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@ or @HHMM@ format. The minutes may
be omitted, in which case we assume a full hour is specified.
be omitted, in which case we assume a full hour is specified. It is also
possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.
In the former case, minutes may be omitted.
A few examples are probably in order. Suppose we have bound the key
above, pressed it, and are now confronted with a prompt:
@ -137,6 +140,10 @@ above, pressed it, and are now confronted with a prompt:
- @hello +d today 12:30@ works just like above, but creates a
deadline.
- @hello +d today 12:30-14:30@ works like the above, but gives the
event a duration of two hours. An alternative way to specify
this would be @hello +d today 12:30+2@.
- @hello +s thu@ would schedule the note for next thursday.
- @hello +s 11@ would schedule it for the 11th of this month and this
@ -356,21 +363,30 @@ refile (asString -> parent) (asString -> fp) =
-- @HH:MM@ time.
data Time = Time
{ date :: Date
, tod :: Maybe TimeOfDay
, tod :: Maybe OrgTime
}
deriving (Eq, Show)
-- | The time in HH:MM.
data TimeOfDay = TimeOfDay Int Int
data TimeOfDay = HHMM Int Int
deriving (Eq)
instance Show TimeOfDay where
show :: TimeOfDay -> String
show (TimeOfDay h m) = pad h <> ":" <> pad m
show (HHMM h m) = pad h <> ":" <> pad m
where
pad :: Int -> String
pad n = (if n <= 9 then "0" else "") <> show n
-- | The time—possibly as a span—in HH:MM format.
data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay
deriving (Eq)
instance Show OrgTime where
show :: OrgTime -> String
show (MomentInTime tod) = show tod
show (TimeSpan tod tod') = show tod <> "-" <> show tod'
-- | Type for specifying exactly which day one wants.
data Date
= Today
@ -383,7 +399,7 @@ data Date
-- ^ Manual date entry in the format DD [MM] [YYYY]
deriving (Eq, Ord, Show)
toOrgFmt :: Maybe TimeOfDay -> Day -> String
toOrgFmt :: Maybe OrgTime -> Day -> String
toOrgFmt tod day =
mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]
where
@ -498,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 <*> pTimeOfDay) <*> pPriority
, Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
[ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pOrgTime) <*> pPriority
, Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pOrgTime) <*> pPriority
, do s <- munch1 (pure True)
let (s', p) = splitAt (length s - 3) s
pure $ case tryPrio p of
@ -533,21 +549,33 @@ pInput inp = (`runParser` inp) . choice $
-- | Parse a 'Priority'.
pPriority :: Parser Priority
pPriority = option NoPriority $
" " *> skipSpaces *> choice
skipSpaces *> choice
[ "#" *> foldCase "a" $> A
, "#" *> foldCase "b" $> B
, "#" *> foldCase "c" $> C
]
-- | Try to parse a 'Time'.
pTimeOfDay :: Parser (Maybe TimeOfDay)
pTimeOfDay = option Nothing $
skipSpaces >> Just <$> choice
[ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM
, pHHMM -- HHMM
, TimeOfDay <$> pHour <*> pure 0 -- HH
]
pOrgTime :: Parser (Maybe OrgTime)
pOrgTime = option Nothing $
between skipSpaces (void " " <|> eof) $
Just <$> choice
[ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay
-- Org is not super smart around times with this syntax, so
-- we pretend not to be as well.
, do from@(HHMM h m) <- pTimeOfDay <* "+"
off <- pHour
pure $ TimeSpan from (HHMM (h + off) m)
, MomentInTime <$> pTimeOfDay
]
where
pTimeOfDay :: Parser TimeOfDay
pTimeOfDay = choice
[ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM
, pHHMM -- HHMM
, HHMM <$> pHour <*> pure 0 -- HH
]
pHHMM :: Parser TimeOfDay
pHHMM = do
let getTwo = count 2 (satisfy isDigit)
@ -555,7 +583,8 @@ pTimeOfDay = option Nothing $
guard (hh >= 0 && hh <= 23)
mm <- read <$> getTwo
guard (mm >= 0 && mm <= 59)
pure $ TimeOfDay hh mm
pure $ HHMM hh mm
pHour :: Parser Int = pNumBetween 0 23
pMinute :: Parser Int = pNumBetween 0 59
@ -566,6 +595,7 @@ pDate = skipSpaces *> choice
, pPrefix "tom" "orrow" Tomorrow
, Next <$> pNext
, Date <$> pDate'
, pure Today -- Fallback to today if no date was given.
]
where
pNext :: Parser DayOfWeek = choice
@ -585,7 +615,7 @@ pDate = skipSpaces *> choice
pDate' :: Parser (Int, Maybe Int, Maybe Integer)
pDate' =
(,,) <$> pNumBetween 1 31 -- day
(,,) <$> (pNumBetween 1 31 <* (void " " <|> eof)) -- day
<*> optional (skipSpaces *> choice
[ pPrefix "ja" "nuary" 1 , pPrefix "f" "ebruary" 2
, pPrefix "mar" "ch" 3 , pPrefix "ap" "ril" 4

26
tests/OrgMode.hs
View File

@ -45,7 +45,7 @@ spec = do
`shouldBe` Just
( Deadline
"todo"
(Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
(Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)})
NoPriority
)
it "works with todo +d 22 jan 2021 01:01 #b" $ do
@ -53,9 +53,14 @@ spec = do
`shouldBe` Just
( Deadline
"todo"
(Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})
(Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)})
B
)
it "parses no day as today when given a time" $ do
pInput "todo +s 12:00"
`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)
context "no priority#b" $ do
it "parses to the correct thing" $
@ -100,10 +105,10 @@ ppPrio = \case
prio -> " #" <> show prio
ppTime :: Time -> String
ppTime (Time d t) = ppDate d <> ppTOD t
ppTime (Time d t) = ppDate d <> ppOrgTime t
where
ppTOD :: Maybe TimeOfDay -> String
ppTOD = maybe "" ((' ' :) . show)
ppOrgTime :: Maybe OrgTime -> String
ppOrgTime = maybe "" ((' ' :) . show)
ppDate :: Date -> String
ppDate dte = case days !? dte of
@ -179,7 +184,7 @@ instance Arbitrary Date where
[ pure Today
, pure Tomorrow
, Next . toEnum <$> choose (0, 6)
, do d <- posInt
, do d <- posInt `suchThat` (<= 31)
m <- mbPos `suchThat` (<= Just 12)
Date . (d, m, ) <$> if isNothing m
then pure Nothing
@ -188,7 +193,14 @@ instance Arbitrary Date where
instance Arbitrary TimeOfDay where
arbitrary :: Gen TimeOfDay
arbitrary = TimeOfDay <$> hourInt <*> minuteInt
arbitrary = HHMM <$> hourInt <*> minuteInt
instance Arbitrary OrgTime where
arbitrary :: Gen OrgTime
arbitrary = oneof
[ MomentInTime <$> arbitrary
, TimeSpan <$> arbitrary <*> arbitrary
]
------------------------------------------------------------------------
-- Util