commit 0669295bfb4fb53ca00d03b1f4f492ad71409cb7
Author: Ava <ava@bensima.com>
Date: Tue Dec 30 22:45:16 2025
Omni/Agent/Telegram: Add /reminders command interface
Implements /reminders command to list, add, edit, delete reminders:
- /reminders - Lists active reminders
- /reminders add <time> <message> - Add reminder with natural language time
- /reminders delete <id> - Delete by ID
- /reminders edit <id> <message> - Edit reminder text
Time parsing supports: tomorrow 3pm, in 2 hours, Dec 31 5pm, ISO format.
Known issue: day rollover bug for relative times near midnight (t-296).
Task-Id: t-291
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs
index 25f07911..11103c26 100644
--- a/Omni/Agent/Telegram.hs
+++ b/Omni/Agent/Telegram.hs
@@ -60,6 +60,7 @@ module Omni.Agent.Telegram
checkAndSendReminders,
recordUserChat,
lookupChatId,
+ handleRemindersCommand,
-- * System Prompt
telegramSystemPrompt,
@@ -79,9 +80,9 @@ import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
-import Data.Time (getCurrentTime, utcToLocalTime)
+import Data.Time (UTCTime, getCurrentTime, utcToLocalTime)
import Data.Time.Format (defaultTimeLocale, formatTime)
-import Data.Time.LocalTime (getCurrentTimeZone)
+import Data.Time.LocalTime (getCurrentTimeZone, minutesToTimeZone)
import qualified Network.HTTP.Client as HTTPClient
import qualified Network.HTTP.Simple as HTTP
import qualified Omni.Agent.AuditLog as AuditLog
@@ -776,8 +777,9 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do
-- Check for special commands before LLM processing
outreachHandled <- handleOutreachCommand tgConfig chatId threadId msgText
+ remindersHandled <- if outreachHandled then pure True else handleRemindersCommand uid chatId threadId msgText
- unless outreachHandled <| handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId
+ unless remindersHandled <| handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId
handleAuthorizedMessageContinued ::
Types.TelegramConfig ->
@@ -961,8 +963,9 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId
-- Check for special commands before LLM processing
outreachHandled <- handleOutreachCommand tgConfig chatId threadId batchedText
+ remindersHandled <- if outreachHandled then pure True else handleRemindersCommand uid chatId threadId batchedText
- unless outreachHandled <| handleAuthorizedMessageBatchContinued tgConfig provider engineCfg msg uid userName chatId batchedText
+ unless remindersHandled <| handleAuthorizedMessageBatchContinued tgConfig provider engineCfg msg uid userName chatId batchedText
handleAuthorizedMessageBatchContinued ::
Types.TelegramConfig ->
@@ -1695,4 +1698,145 @@ formatDraftForReview draft =
"reply `/approve " <> Outreach.draftId draft <> "` or `/reject " <> Outreach.draftId draft <> " [reason]`"
]
+-- | Handle /reminders commands
+-- Commands:
+-- /reminders - List active reminders
+-- /reminders add <time> <message> - Add new reminder
+-- /reminders delete <id> - Delete a reminder
+-- /reminders edit <id> <new message> - Edit reminder text
+handleRemindersCommand :: Text -> Int -> Maybe Int -> Text -> IO Bool
+handleRemindersCommand uid chatId mThreadId cmd
+ | cmd == "/reminders" || cmd == "/reminders " = do
+ reminders <- Reminders.listReminders uid
+ if null reminders
+ then do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId "no active reminders" (Just "system") Nothing
+ pure True
+ else do
+ let msg = formatRemindersForDisplay reminders
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId msg (Just "system") Nothing
+ pure True
+ | "/reminders add " `Text.isPrefixOf` cmd = do
+ let rest = Text.strip (Text.drop 15 cmd)
+ case parseAddCommand rest of
+ Nothing -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId "usage: /reminders add <time> <message>\nexamples:\n /reminders add tomorrow 3pm Pick up groceries\n /reminders add in 2 hours Check on laundry\n /reminders add Dec 31 5pm New Year prep" (Just "system") Nothing
+ pure True
+ Just (timeStr, message) -> do
+ mTime <- Reminders.parseReminderTime timeStr
+ case mTime of
+ Nothing -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("couldn't parse time: \"" <> timeStr <> "\"\ntry: tomorrow 3pm, in 2 hours, Dec 31 5pm, or 2024-12-31 17:00") (Just "system") Nothing
+ pure True
+ Just dueAt -> do
+ reminder <- Reminders.addReminder uid dueAt message
+ let formattedTime = formatReminderTime (Reminders.reminderDueAt reminder)
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("✅ Reminder set for " <> formattedTime <> ": " <> Reminders.reminderMessage reminder) (Just "system") Nothing
+ pure True
+ | "/reminders delete " `Text.isPrefixOf` cmd = do
+ let idStr = Text.strip (Text.drop 18 cmd)
+ case readMaybe (Text.unpack idStr) of
+ Nothing -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId "usage: /reminders delete <id>" (Just "system") Nothing
+ pure True
+ Just rid -> do
+ mTitle <- Reminders.deleteReminder uid rid
+ case mTitle of
+ Nothing -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("reminder #" <> tshow rid <> " not found") (Just "system") Nothing
+ pure True
+ Just title -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("✅ Deleted reminder: " <> title) (Just "system") Nothing
+ pure True
+ | "/reminders edit " `Text.isPrefixOf` cmd = do
+ let rest = Text.strip (Text.drop 16 cmd)
+ (idStr, newMessage) = Text.breakOn " " rest
+ case readMaybe (Text.unpack idStr) of
+ Nothing -> do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId "usage: /reminders edit <id> <new message>" (Just "system") Nothing
+ pure True
+ Just rid -> do
+ let msg = Text.strip newMessage
+ if Text.null msg
+ then do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId "usage: /reminders edit <id> <new message>" (Just "system") Nothing
+ pure True
+ else do
+ success <- Reminders.editReminder uid rid msg
+ if success
+ then do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("✅ Updated reminder #" <> tshow rid <> ": " <> msg) (Just "system") Nothing
+ pure True
+ else do
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId ("reminder #" <> tshow rid <> " not found") (Just "system") Nothing
+ pure True
+ | "/reminders" `Text.isPrefixOf` cmd = do
+ -- Unknown subcommand - show help
+ _ <- Messages.enqueueImmediate (Just uid) chatId mThreadId remindersHelpText (Just "system") Nothing
+ pure True
+ | otherwise = pure False
+-- | Parse "add" command: extract time and message from input
+-- E.g., "tomorrow 3pm Pick up groceries" -> Just ("tomorrow 3pm", "Pick up groceries")
+parseAddCommand :: Text -> Maybe (Text, Text)
+parseAddCommand input = do
+ let txt = Text.strip input
+ guard (not (Text.null txt))
+ -- Try to find where time ends and message begins
+ -- Strategy: try progressively longer time prefixes until parsing fails
+ let words' = Text.words txt
+ findSplit words' 1
+ where
+ findSplit words' n
+ | n > length words' = Nothing
+ | n > 4 = Nothing -- Max 4 words for time specification
+ | otherwise =
+ let timeWords = take n words'
+ msgWords = drop n words'
+ timeStr = Text.unwords timeWords
+ in if null msgWords
+ then findSplit words' (n + 1) -- Need at least one message word
+ else Just (timeStr, Text.unwords msgWords)
+
+-- | Format reminders for display in Telegram
+formatRemindersForDisplay :: [Reminders.Reminder] -> Text
+formatRemindersForDisplay reminders =
+ Text.unlines
+ <| ["*Your reminders:*", ""]
+ <> zipWith formatReminder [1 :: Int ..] reminders
+ where
+ formatReminder n r =
+ tshow n
+ <> ". ["
+ <> formatReminderTime (Reminders.reminderDueAt r)
+ <> "] "
+ <> Reminders.reminderMessage r
+ <> " (id: "
+ <> tshow (Reminders.reminderId r)
+ <> ")"
+
+-- | Format a reminder time for display
+formatReminderTime :: UTCTime -> Text
+formatReminderTime utc =
+ let localTime = utcToLocalTime easternTZ utc
+ in Text.pack (formatTime defaultTimeLocale "%b %d %-l:%M%P" localTime)
+ where
+ easternTZ = minutesToTimeZone (-300)
+
+-- | Help text for /reminders command
+remindersHelpText :: Text
+remindersHelpText =
+ Text.unlines
+ [ "*Reminders Commands:*",
+ "",
+ "`/reminders` - List active reminders",
+ "`/reminders add <time> <message>` - Add reminder",
+ "`/reminders delete <id>` - Delete reminder",
+ "`/reminders edit <id> <message>` - Edit reminder",
+ "",
+ "*Time formats:*",
+ " tomorrow 3pm",
+ " in 2 hours",
+ " Dec 31 5pm",
+ " 2024-12-31 17:00"
+ ]
diff --git a/Omni/Agent/Telegram/Reminders.hs b/Omni/Agent/Telegram/Reminders.hs
index 88aab0a2..1ddaeded 100644
--- a/Omni/Agent/Telegram/Reminders.hs
+++ b/Omni/Agent/Telegram/Reminders.hs
@@ -5,6 +5,7 @@
--
-- : out omni-agent-telegram-reminders
-- : dep sqlite-simple
+-- : dep time
module Omni.Agent.Telegram.Reminders
( -- * User Chat Persistence
initUserChatsTable,
@@ -15,6 +16,14 @@ module Omni.Agent.Telegram.Reminders
reminderLoop,
checkAndSendReminders,
+ -- * Reminder CRUD (for /reminders command)
+ Reminder (..),
+ listReminders,
+ addReminder,
+ editReminder,
+ deleteReminder,
+ parseReminderTime,
+
-- * Testing
main,
test,
@@ -22,7 +31,11 @@ module Omni.Agent.Telegram.Reminders
where
import Alpha
-import Data.Time (getCurrentTime)
+import qualified Data.Text as Text
+import Data.Time (LocalTime, TimeZone, UTCTime, getCurrentTime, localTimeToUTC, minutesToTimeZone, utcToLocalTime)
+import qualified Data.Time.Calendar as Calendar
+import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
+import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), localDay, localTimeOfDay)
import qualified Database.SQLite.Simple as SQL
import qualified Omni.Agent.Memory as Memory
import qualified Omni.Agent.Telegram.Messages as Messages
@@ -40,9 +53,160 @@ test =
Memory.withMemoryDb <| \conn -> do
initUserChatsTable conn
initUserChatsTable conn
- pure ()
+ pure (),
+ Test.unit "parseReminderTime handles 'tomorrow 3pm'" <| do
+ result <- parseReminderTime "tomorrow 3pm"
+ isJust result Test.@=? True,
+ Test.unit "parseReminderTime handles ISO format" <| do
+ result <- parseReminderTime "2024-12-31 17:00"
+ isJust result Test.@=? True
]
+-- | A reminder is a todo with a due date, displayed for the /reminders command
+data Reminder = Reminder
+ { reminderId :: Int,
+ reminderMessage :: Text,
+ reminderDueAt :: UTCTime,
+ reminderCompleted :: Bool
+ }
+ deriving (Show, Eq)
+
+-- | Eastern timezone (EST = UTC-5)
+easternTimeZone :: TimeZone
+easternTimeZone = minutesToTimeZone (-300)
+
+-- | List active (non-completed) reminders for a user
+listReminders :: Text -> IO [Reminder]
+listReminders uid = do
+ todos <- Todos.listPendingTodos uid 50
+ let reminders =
+ [ Reminder
+ { reminderId = Todos.todoId td,
+ reminderMessage = Todos.todoTitle td,
+ reminderDueAt = dueDate,
+ reminderCompleted = Todos.todoCompleted td
+ }
+ | td <- todos,
+ Just dueDate <- [Todos.todoDueDate td]
+ ]
+ pure reminders
+
+-- | Add a new reminder with parsed time
+addReminder :: Text -> UTCTime -> Text -> IO Reminder
+addReminder uid dueAt message = do
+ let dueDateStr = Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M" (utcToLocalTime easternTimeZone dueAt))
+ td <- Todos.createTodo uid message (Just dueDateStr)
+ pure
+ Reminder
+ { reminderId = Todos.todoId td,
+ reminderMessage = Todos.todoTitle td,
+ reminderDueAt = fromMaybe dueAt (Todos.todoDueDate td),
+ reminderCompleted = False
+ }
+
+-- | Edit a reminder's message
+editReminder :: Text -> Int -> Text -> IO Bool
+editReminder uid rid newMessage =
+ Memory.withMemoryDb <| \conn -> do
+ Todos.initTodosTable conn
+ SQL.execute
+ conn
+ "UPDATE todos SET title = ? WHERE id = ? AND user_id = ?"
+ (newMessage, rid, uid)
+ changes <- SQL.changes conn
+ pure (changes > 0)
+
+-- | Delete a reminder
+deleteReminder :: Text -> Int -> IO (Maybe Text)
+deleteReminder uid rid = do
+ -- First get the title for confirmation message
+ todos <- Todos.listTodos uid 100
+ let mTitle = listToMaybe [Todos.todoTitle td | td <- todos, Todos.todoId td == rid]
+ deleted <- Todos.deleteTodo uid rid
+ pure (if deleted then mTitle else Nothing)
+
+-- | Parse natural language time expressions
+-- Supports: "tomorrow 3pm", "Dec 31 5pm", "2024-12-31 17:00", "in 2 hours"
+parseReminderTime :: Text -> IO (Maybe UTCTime)
+parseReminderTime input = do
+ now <- getCurrentTime
+ let localNow = utcToLocalTime easternTimeZone now
+ today = localDay localNow
+ inputLower = Text.toLower (Text.strip input)
+ pure (parseTime localNow today inputLower)
+ where
+ parseTime localNow today txt
+ -- "tomorrow 3pm" or "tomorrow 3:30pm"
+ | "tomorrow" `Text.isPrefixOf` txt =
+ let timeStr = Text.strip (Text.drop 8 txt)
+ tomorrow = Calendar.addDays 1 today
+ in parseTimeOfDay timeStr +> \tod -> Just (localTimeToUTC easternTimeZone (LocalTime tomorrow tod))
+ -- "in X hours" or "in X minutes"
+ | "in " `Text.isPrefixOf` txt =
+ let rest = Text.drop 3 txt
+ in parseRelativeTime localNow rest
+ -- ISO format: "2024-12-31 17:00"
+ | otherwise =
+ parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M" (Text.unpack txt)
+ <|> parseTimeM True defaultTimeLocale "%Y-%m-%d" (Text.unpack txt)
+ <|> parseMonthDayTime today txt
+
+ parseTimeOfDay :: Text -> Maybe TimeOfDay
+ parseTimeOfDay txt =
+ parseTimeM True defaultTimeLocale "%l%P" (Text.unpack txt)
+ <|> parseTimeM True defaultTimeLocale "%l:%M%P" (Text.unpack txt)
+ <|> parseTimeM True defaultTimeLocale "%H:%M" (Text.unpack txt)
+ <|> parseTimeM True defaultTimeLocale "%l %P" (Text.unpack txt)
+
+ parseRelativeTime :: LocalTime -> Text -> Maybe UTCTime
+ parseRelativeTime localNow txt =
+ let words' = Text.words txt
+ in case words' of
+ [numTxt, unit]
+ | "hour" `Text.isPrefixOf` unit -> do
+ n <- readMaybe (Text.unpack numTxt)
+ let newTod = addHours n (localTimeOfDay localNow)
+ pure (localTimeToUTC easternTimeZone (localNow {localTimeOfDay = newTod}))
+ | "minute" `Text.isPrefixOf` unit -> do
+ n <- readMaybe (Text.unpack numTxt)
+ let newTod = addMinutes n (localTimeOfDay localNow)
+ pure (localTimeToUTC easternTimeZone (localNow {localTimeOfDay = newTod}))
+ _ -> Nothing
+
+ addHours :: Int -> TimeOfDay -> TimeOfDay
+ addHours h tod =
+ let totalMins = todHour tod * 60 + todMin tod + h * 60
+ newHour = (totalMins `div` 60) `mod` 24
+ newMin = totalMins `mod` 60
+ in TimeOfDay newHour newMin (todSec tod)
+
+ addMinutes :: Int -> TimeOfDay -> TimeOfDay
+ addMinutes m tod =
+ let totalMins = todHour tod * 60 + todMin tod + m
+ newHour = (totalMins `div` 60) `mod` 24
+ newMin = totalMins `mod` 60
+ in TimeOfDay newHour newMin (todSec tod)
+
+ -- Parse "Dec 31 5pm" or "December 31 5:00pm"
+ parseMonthDayTime :: Calendar.Day -> Text -> Maybe UTCTime
+ parseMonthDayTime today txt =
+ let formats =
+ [ "%b %d %l%P",
+ "%b %d %l:%M%P",
+ "%B %d %l%P",
+ "%B %d %l:%M%P",
+ "%b %d %H:%M",
+ "%B %d %H:%M"
+ ]
+ in listToMaybe (mapMaybe (\fmt -> parseWithYear today fmt txt) formats)
+
+ parseWithYear :: Calendar.Day -> String -> Text -> Maybe UTCTime
+ parseWithYear today fmt txt = do
+ -- Try parsing with current year first
+ let (year, _, _) = Calendar.toGregorian today
+ withYear = Text.unpack txt <> " " <> show year
+ parseTimeM True defaultTimeLocale (fmt <> " %Y") withYear
+
initUserChatsTable :: SQL.Connection -> IO ()
initUserChatsTable conn =
SQL.execute_