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

Merge pull request #747 from slotThe/org-mode/priorities

Browse Source 
X.P.OrgMode: Add ability to specify priorities
This commit is contained in:
Tony Zorman 2022-08-24 14:36:35 +02:00 committed by GitHub
commit 113dda4389
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 110 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGES.md
View File

@ -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

91
XMonad/Prompt/OrgMode.hs
View File

@ -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

45
tests/OrgMode.hs
View File

@ -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,29 @@ spec = do
( Deadline
"todo"
(Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
NoPriority
)
it "works with todo +d 22 jan 2021 01:01 #b" $ do
pInput "todo +d 22 jan 2021 01:01 #b"
`shouldBe` Just
( Deadline
"todo"
(Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})
B
)
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 #c" $ do
it "encode" $ prop_encodePreservation (OrgMsg "+d +d f")
it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) C)
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)
context "+d f 1 +d f #b" $ do
it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f #b")
it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) B)
-- | Parsing preserves all info that printing does.
prop_encodePreservation :: OrgMsg -> Property
@ -66,9 +83,14 @@ 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 p -> str <> " +s " <> ppTime t <> ppPrio p
Deadline str t p -> str <> " +d " <> ppTime t <> ppPrio p
NormalMsg str p -> str <> ppPrio p
ppPrio :: Priority -> String
ppPrio = \case
NoPriority -> ""
prio -> " #" <> show prio
ppTime :: Time -> String
ppTime (Time d t) = ppDate d <> ppTOD t
@ -93,8 +115,10 @@ newtype OrgMsg = OrgMsg String
instance Arbitrary OrgMsg where
arbitrary :: Gen OrgMsg
arbitrary = OrgMsg <$>
randomString <<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen
arbitrary
= OrgMsg <$> randomString -- note
<<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen -- time and date
<<>> elements ("" : map (reverse . (: " #")) "AaBbCc") -- priority
where
dateGen :: Gen String
dateGen = oneof
@ -130,7 +154,12 @@ instance Arbitrary Note where
arbitrary = do
msg <- randomString
t <- arbitrary
elements [Scheduled msg t, Deadline msg t, NormalMsg msg]
p <- arbitrary
elements [Scheduled msg t p, Deadline msg t p, NormalMsg msg p]
instance Arbitrary Priority where
arbitrary :: Gen Priority
arbitrary = elements [A, B, C, NoPriority]
instance Arbitrary Time where
arbitrary :: Gen Time