summaryrefslogtreecommitdiff
path: root/Omni/Agent/Telegram/Reminders.hs
blob: 706f9da29dd0e83acd7b0a58966f84b05ab05d75 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
{-# 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