{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Telegram Reminders - Background reminder loop and user chat persistence. -- -- : out omni-agent-telegram-reminders -- : dep sqlite-simple module Omni.Agent.Telegram.Reminders ( -- * User Chat Persistence initUserChatsTable, recordUserChat, lookupChatId, -- * Reminder Loop reminderLoop, checkAndSendReminders, -- * Testing main, test, ) where import Alpha import Data.Time (getCurrentTime) import qualified Database.SQLite.Simple as SQL import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Todos as Todos import qualified Omni.Test as Test main :: IO () main = Test.run test test :: Test.Tree test = Test.group "Omni.Agent.Telegram.Reminders" [ Test.unit "initUserChatsTable is idempotent" <| do Memory.withMemoryDb <| \conn -> do initUserChatsTable conn initUserChatsTable conn pure () ] initUserChatsTable :: SQL.Connection -> IO () initUserChatsTable conn = SQL.execute_ conn "CREATE TABLE IF NOT EXISTS user_chats (\ \ user_id TEXT PRIMARY KEY,\ \ chat_id INTEGER NOT NULL,\ \ last_seen_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\ \)" recordUserChat :: Text -> Int -> IO () recordUserChat uid chatId = do now <- getCurrentTime Memory.withMemoryDb <| \conn -> do initUserChatsTable conn SQL.execute conn "INSERT INTO user_chats (user_id, chat_id, last_seen_at) \ \VALUES (?, ?, ?) \ \ON CONFLICT(user_id) DO UPDATE SET \ \ chat_id = excluded.chat_id, \ \ last_seen_at = excluded.last_seen_at" (uid, chatId, now) lookupChatId :: Text -> IO (Maybe Int) lookupChatId uid = Memory.withMemoryDb <| \conn -> do initUserChatsTable conn rows <- SQL.query conn "SELECT chat_id FROM user_chats WHERE user_id = ?" (SQL.Only uid) pure (listToMaybe (map SQL.fromOnly rows)) reminderLoop :: Types.TelegramConfig -> (Types.TelegramConfig -> Int -> Text -> IO ()) -> IO () reminderLoop tgConfig sendMsg = forever <| do threadDelay (5 * 60 * 1000000) checkAndSendReminders tgConfig sendMsg checkAndSendReminders :: Types.TelegramConfig -> (Types.TelegramConfig -> Int -> Text -> IO ()) -> IO () checkAndSendReminders tgConfig sendMsg = do todos <- Todos.listTodosDueForReminder forM_ todos <| \td -> do mChatId <- lookupChatId (Todos.todoUserId td) case mChatId of Nothing -> pure () Just chatId -> do let title = Todos.todoTitle td dueStr = case Todos.todoDueDate td of Just d -> " (due: " <> tshow d <> ")" Nothing -> "" msg = "⏰ reminder: \"" <> title <> "\"" <> dueStr <> "\nreply when you finish and i'll mark it complete." sendMsg tgConfig chatId msg Todos.markReminderSent (Todos.todoId td) putText <| "Sent reminder for todo " <> tshow (Todos.todoId td) <> " to chat " <> tshow chatId