diff --git a/CHANGES.md b/CHANGES.md index 9746ae64..eb467450 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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 diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs index 23063ade..1e2289a7 100644 --- a/XMonad/Prompt/OrgMode.hs +++ b/XMonad/Prompt/OrgMode.hs @@ -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 +. +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 diff --git a/tests/OrgMode.hs b/tests/OrgMode.hs index 0a3be0af..9c609037 100644 --- a/tests/OrgMode.hs +++ b/tests/OrgMode.hs @@ -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