mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
X.P.OrgMode: Add ability to specify priorities
Add the ability to specify alphabetic (`#A`, `#B`, and `#C`) org-mode priorities[1] at the end of the input note. [1]: https://orgmode.org/manual/Priorities.html
This commit is contained in:
Tony Zorman
parent
ae7f615b60
commit
68b5a12f96
@ -106,8 +106,11 @@
|
||||
|
||||
* `XMonad.Prompt.OrgMode`
|
||||
|
||||
- Fixes the date parsing issue such that entries with format of
|
||||
`todo +d 12 02 2024` works.
|
||||
- Fixed the date parsing issue such that entries with a format of
|
||||
`todo +d 12 02 2024` work.
|
||||
|
||||
- Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)
|
||||
[priorities] at the end of the input note.
|
||||
|
||||
* `XMonad.Prompt`
|
||||
|
||||
@ -236,6 +239,7 @@
|
||||
- Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`.
|
||||
|
||||
[this PR]: https://github.com/xmonad/xmonad-contrib/pull/744
|
||||
[priorities]: https://orgmode.org/manual/Priorities.html
|
||||
|
||||
### Other changes
|
||||
|
||||
|
||||
@ -2,8 +2,9 @@
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
--------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Prompt.OrgMode
|
||||
@ -20,9 +21,9 @@
|
||||
-- "XMonad.Prompt.AppendFile", allowing for more interesting
|
||||
-- interactions with that particular file type.
|
||||
--
|
||||
-- It can be used to quickly save TODOs, NOTEs, and the like with
|
||||
-- the additional capability to schedule/deadline a task, or use
|
||||
-- the system's clipboard (really: the primary selection) as the
|
||||
-- It can be used to quickly save TODOs, NOTEs, and the like with the
|
||||
-- additional capability to schedule/deadline a task, add a priority,
|
||||
-- and use the system's clipboard (really: the primary selection) as the
|
||||
-- contents of the note.
|
||||
--
|
||||
--------------------------------------------------------------------
|
||||
@ -41,6 +42,7 @@ module XMonad.Prompt.OrgMode (
|
||||
#ifdef TESTING
|
||||
pInput,
|
||||
Note (..),
|
||||
Priority (..),
|
||||
Date (..),
|
||||
Time (..),
|
||||
TimeOfDay (..),
|
||||
@ -132,6 +134,12 @@ undefined parsing behaviour. Otherwise, what should @message +s 11 jan
|
||||
13@ resolve to—the 11th of january at 13:00 or the 11th of january in
|
||||
the year 13?
|
||||
|
||||
There is basic support for alphabetic org-mode
|
||||
<https:\/\/orgmode.org\/manual\/Priorities.html priorities>.
|
||||
Simply append either @#A@, @#B@, or @#C@ (capitalisation is optional) to
|
||||
the end of the note. For example, one could write @"hello +s 11 jan
|
||||
2013 #A"@ or @"hello #C"@.
|
||||
|
||||
There's also the possibility to take what's currently in the primary
|
||||
selection and paste that as the content of the created note. This is
|
||||
especially useful when you want to quickly save a URL for later and
|
||||
@ -327,26 +335,39 @@ instance Enum DayOfWeek where
|
||||
|
||||
-- | An @org-mode@ style note.
|
||||
data Note
|
||||
= Scheduled String Time
|
||||
| Deadline String Time
|
||||
| NormalMsg String
|
||||
= Scheduled String Time Priority
|
||||
| Deadline String Time Priority
|
||||
| NormalMsg String Priority
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | An @org-mode@ style priority symbol[1]; e.g., something like
|
||||
-- @[#A]@. Note that this uses the standard org conventions: supported
|
||||
-- priorities are @A@, @B@, and @C@, with @A@ being the highest.
|
||||
-- Numerical priorities are not supported.
|
||||
--
|
||||
-- [1]: https://orgmode.org/manual/Priorities.html
|
||||
data Priority = A | B | C | NoPriority
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Pretty print a given 'Note'.
|
||||
ppNote :: Clp -> String -> Note -> IO String
|
||||
ppNote clp todo = \case
|
||||
Scheduled str time -> mkLine str "SCHEDULED: " (Just time)
|
||||
Deadline str time -> mkLine str "DEADLINE: " (Just time)
|
||||
NormalMsg str -> mkLine str "" Nothing
|
||||
Scheduled str time prio -> mkLine str "SCHEDULED: " (Just time) prio
|
||||
Deadline str time prio -> mkLine str "DEADLINE: " (Just time) prio
|
||||
NormalMsg str prio -> mkLine str "" Nothing prio
|
||||
where
|
||||
mkLine :: String -> String -> Maybe Time -> IO String
|
||||
mkLine str sched time = do
|
||||
mkLine :: String -> String -> Maybe Time -> Priority -> IO String
|
||||
mkLine str sched time prio = do
|
||||
t <- case time of
|
||||
Nothing -> pure ""
|
||||
Just ti -> (("\n " <> sched) <>) <$> ppDate ti
|
||||
pure $ case clp of
|
||||
Body c -> mconcat ["* ", todo, " ", str, t, c]
|
||||
Header c -> mconcat ["* ", todo, " [[", c, "][", str,"]]", t]
|
||||
pure $ "* " <> todo <> priority <> case clp of
|
||||
Body c -> mconcat [str, t, c]
|
||||
Header c -> mconcat ["[[", c, "][", str,"]]", t]
|
||||
where
|
||||
priority = case prio of
|
||||
NoPriority -> " "
|
||||
otherPrio -> " [#" <> show otherPrio <> "] "
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Parsing
|
||||
@ -354,16 +375,29 @@ 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)
|
||||
, Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay)
|
||||
, NormalMsg <$> munch1 (const True)
|
||||
[ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
|
||||
, Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
|
||||
, do s <- munch1 (pure True)
|
||||
let (s', p) = splitAt (length s - 2) s
|
||||
pure $ case tryPrio p of
|
||||
Just prio -> NormalMsg (dropStripEnd 0 s') prio
|
||||
Nothing -> NormalMsg s NoPriority
|
||||
]
|
||||
where
|
||||
tryPrio :: String -> Maybe Priority
|
||||
tryPrio ['#', x]
|
||||
| x `elem` ("Aa" :: String) = Just A
|
||||
| x `elem` ("Bb" :: String) = Just B
|
||||
| x `elem` ("Cc" :: String) = Just C
|
||||
tryPrio _ = Nothing
|
||||
|
||||
-- Trim whitespace at the end of a string after dropping some number
|
||||
-- of characters from it.
|
||||
dropStripEnd :: Int -> String -> String
|
||||
dropStripEnd n = reverse . dropWhile (== ' ') . drop n . reverse
|
||||
|
||||
getLast :: String -> Parser String
|
||||
getLast ptn = reverse
|
||||
. dropWhile (== ' ') -- trim whitespace at the end
|
||||
. drop (length ptn) -- drop only the last pattern
|
||||
. reverse
|
||||
getLast ptn = dropStripEnd (length ptn) -- drop only the last pattern before stripping
|
||||
. concat
|
||||
<$> endBy1 (go "") (pure ptn)
|
||||
where
|
||||
@ -373,6 +407,15 @@ pInput inp = (`runParser` inp) . choice $
|
||||
word <- munch1 (/= ' ')
|
||||
bool go pure (word == ptn) $ consumed <> str <> word
|
||||
|
||||
-- | Parse a 'Priority'.
|
||||
pPriority :: Parser Priority
|
||||
pPriority = skipSpaces *> choice
|
||||
[ "#" *> ("A" <|> "a") $> A
|
||||
, "#" *> ("B" <|> "b") $> B
|
||||
, "#" *> ("C" <|> "c") $> C
|
||||
, pure NoPriority
|
||||
]
|
||||
|
||||
-- | Try to parse a 'Time'.
|
||||
pTimeOfDay :: Parser (Maybe TimeOfDay)
|
||||
pTimeOfDay = choice
|
||||
@ -424,9 +467,9 @@ pDate = skipSpaces *> choice
|
||||
|
||||
-- | Parse a prefix and drop a potential suffix up to the next (space
|
||||
-- separated) word. If successful, return @ret@.
|
||||
pPrefix :: String -> String -> a -> Parser a
|
||||
pPrefix :: Parser String -> String -> a -> Parser a
|
||||
pPrefix start leftover ret = do
|
||||
void $ string start
|
||||
void start
|
||||
l <- munch (/= ' ')
|
||||
guard (l `isPrefixOf` leftover)
|
||||
pure ret
|
||||
|
||||
@ -30,6 +30,7 @@ spec = do
|
||||
( Deadline
|
||||
"todo"
|
||||
(Time {date = Date (22, Just 1, Just 2021), tod = Nothing})
|
||||
NoPriority
|
||||
)
|
||||
it "works with todo +d 22 01 2022" $ do
|
||||
pInput "todo +d 22 01 2022"
|
||||
@ -37,6 +38,7 @@ spec = do
|
||||
( Deadline
|
||||
"todo"
|
||||
(Time {date = Date (22, Just 1, Just 2022), tod = Nothing})
|
||||
NoPriority
|
||||
)
|
||||
it "works with todo +d 1 01:01" $ do
|
||||
pInput "todo +d 1 01:01"
|
||||
@ -44,14 +46,15 @@ spec = do
|
||||
( Deadline
|
||||
"todo"
|
||||
(Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
|
||||
NoPriority
|
||||
)
|
||||
|
||||
context "+d +d f" $ do
|
||||
it "encode" $ prop_encodePreservation (OrgMsg "+d +d f")
|
||||
it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}))
|
||||
it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) NoPriority)
|
||||
context "+d f 1 +d f" $ do
|
||||
it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f")
|
||||
it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}))
|
||||
it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) NoPriority)
|
||||
|
||||
-- | Parsing preserves all info that printing does.
|
||||
prop_encodePreservation :: OrgMsg -> Property
|
||||
@ -66,9 +69,9 @@ prop_decodePreservation n = Just (ppNote n) === (fmap ppNote . pInput $ ppNote n
|
||||
|
||||
ppNote :: Note -> String
|
||||
ppNote = \case
|
||||
Scheduled str t -> str <> " +s " <> ppTime t
|
||||
Deadline str t -> str <> " +d " <> ppTime t
|
||||
NormalMsg str -> str
|
||||
Scheduled str t _ -> str <> " +s " <> ppTime t
|
||||
Deadline str t _ -> str <> " +d " <> ppTime t
|
||||
NormalMsg str _ -> str
|
||||
|
||||
ppTime :: Time -> String
|
||||
ppTime (Time d t) = ppDate d <> ppTOD t
|
||||
@ -130,7 +133,7 @@ instance Arbitrary Note where
|
||||
arbitrary = do
|
||||
msg <- randomString
|
||||
t <- arbitrary
|
||||
elements [Scheduled msg t, Deadline msg t, NormalMsg msg]
|
||||
elements [Scheduled msg t NoPriority, Deadline msg t NoPriority, NormalMsg msg NoPriority]
|
||||
|
||||
instance Arbitrary Time where
|
||||
arbitrary :: Gen Time
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user