summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
authorBen Sima <ben@bensima.com>2025-12-12 21:27:57 -0500
committerBen Sima <ben@bensima.com>2025-12-12 21:27:57 -0500
commit49f6fe47e19c42b87615dd2d75e53f43331e00ab (patch)
tree2ea2b6ad281fc4f2890eb29c134da6d32d049a7f /Omni
parentfd1c5c2bda7831c6cf329f4dc272064a352609e1 (diff)
Add todo tools with due dates
- Omni/Agent/Tools/Todos.hs: todo_add, todo_list, todo_complete, todo_delete - Supports optional due dates in YYYY-MM-DD or YYYY-MM-DD HH:MM format - Lists can filter by pending, all, or overdue - Add todos table to Memory.hs schema - Wire into Telegram bot
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Agent/Memory.hs16
-rw-r--r--Omni/Agent/Telegram.hs9
-rw-r--r--Omni/Agent/Tools/Todos.hs468
3 files changed, 492 insertions, 1 deletions
diff --git a/Omni/Agent/Memory.hs b/Omni/Agent/Memory.hs
index d40bb34..136ac1e 100644
--- a/Omni/Agent/Memory.hs
+++ b/Omni/Agent/Memory.hs
@@ -533,6 +533,22 @@ initMemoryDb conn = do
SQL.execute_
conn
"CREATE INDEX IF NOT EXISTS idx_notes_topic ON notes(user_id, topic)"
+ SQL.execute_
+ conn
+ "CREATE TABLE IF NOT EXISTS todos (\
+ \ id INTEGER PRIMARY KEY AUTOINCREMENT,\
+ \ user_id TEXT NOT NULL,\
+ \ title TEXT NOT NULL,\
+ \ due_date TIMESTAMP,\
+ \ completed INTEGER NOT NULL DEFAULT 0,\
+ \ created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\
+ \)"
+ SQL.execute_
+ conn
+ "CREATE INDEX IF NOT EXISTS idx_todos_user ON todos(user_id)"
+ SQL.execute_
+ conn
+ "CREATE INDEX IF NOT EXISTS idx_todos_due ON todos(user_id, due_date)"
-- | Migrate conversation_messages to add sender_name column.
migrateConversationMessages :: SQL.Connection -> IO ()
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs
index 9142b4a..f1c71e6 100644
--- a/Omni/Agent/Telegram.hs
+++ b/Omni/Agent/Telegram.hs
@@ -70,6 +70,7 @@ import qualified Omni.Agent.Provider as Provider
import qualified Omni.Agent.Tools.Calendar as Calendar
import qualified Omni.Agent.Tools.Notes as Notes
import qualified Omni.Agent.Tools.Pdf as Pdf
+import qualified Omni.Agent.Tools.Todos as Todos
import qualified Omni.Agent.Tools.WebSearch as WebSearch
import qualified Omni.Test as Test
import System.Environment (lookupEnv)
@@ -702,7 +703,13 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do
Calendar.calendarAddTool,
Calendar.calendarSearchTool
]
- tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools
+ todoTools =
+ [ Todos.todoAddTool uid,
+ Todos.todoListTool uid,
+ Todos.todoCompleteTool uid,
+ Todos.todoDeleteTool uid
+ ]
+ tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools <> todoTools
let agentCfg =
Engine.defaultAgentConfig
diff --git a/Omni/Agent/Tools/Todos.hs b/Omni/Agent/Tools/Todos.hs
new file mode 100644
index 0000000..81253c1
--- /dev/null
+++ b/Omni/Agent/Tools/Todos.hs
@@ -0,0 +1,468 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Todo tool with due dates and reminders.
+--
+-- Provides user-scoped todos with optional due dates.
+--
+-- : out omni-agent-tools-todos
+-- : dep aeson
+-- : dep sqlite-simple
+-- : dep time
+module Omni.Agent.Tools.Todos
+ ( -- * Tools
+ todoAddTool,
+ todoListTool,
+ todoCompleteTool,
+ todoDeleteTool,
+
+ -- * Direct API
+ Todo (..),
+ createTodo,
+ listTodos,
+ listPendingTodos,
+ listOverdueTodos,
+ completeTodo,
+ deleteTodo,
+
+ -- * Database
+ initTodosTable,
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import Data.Aeson ((.!=), (.:), (.:?), (.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.Text as Text
+import Data.Time (UTCTime, getCurrentTime)
+import Data.Time.Format (defaultTimeLocale, parseTimeM)
+import qualified Database.SQLite.Simple as SQL
+import qualified Omni.Agent.Engine as Engine
+import qualified Omni.Agent.Memory as Memory
+import qualified Omni.Test as Test
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Tools.Todos"
+ [ Test.unit "todoAddTool has correct schema" <| do
+ let tool = todoAddTool "test-user-id"
+ Engine.toolName tool Test.@=? "todo_add",
+ Test.unit "todoListTool has correct schema" <| do
+ let tool = todoListTool "test-user-id"
+ Engine.toolName tool Test.@=? "todo_list",
+ Test.unit "todoCompleteTool has correct schema" <| do
+ let tool = todoCompleteTool "test-user-id"
+ Engine.toolName tool Test.@=? "todo_complete",
+ Test.unit "todoDeleteTool has correct schema" <| do
+ let tool = todoDeleteTool "test-user-id"
+ Engine.toolName tool Test.@=? "todo_delete",
+ Test.unit "Todo JSON roundtrip" <| do
+ now <- getCurrentTime
+ let td =
+ Todo
+ { todoId = 1,
+ todoUserId = "user-123",
+ todoTitle = "Buy milk",
+ todoDueDate = Just now,
+ todoCompleted = False,
+ todoCreatedAt = now
+ }
+ case Aeson.decode (Aeson.encode td) of
+ Nothing -> Test.assertFailure "Failed to decode Todo"
+ Just decoded -> do
+ todoTitle decoded Test.@=? "Buy milk"
+ todoCompleted decoded Test.@=? False,
+ Test.unit "parseDueDate handles various formats" <| do
+ isJust (parseDueDate "2024-12-25") Test.@=? True
+ isJust (parseDueDate "2024-12-25 14:00") Test.@=? True
+ ]
+
+data Todo = Todo
+ { todoId :: Int,
+ todoUserId :: Text,
+ todoTitle :: Text,
+ todoDueDate :: Maybe UTCTime,
+ todoCompleted :: Bool,
+ todoCreatedAt :: UTCTime
+ }
+ deriving (Show, Eq, Generic)
+
+instance Aeson.ToJSON Todo where
+ toJSON td =
+ Aeson.object
+ [ "id" .= todoId td,
+ "user_id" .= todoUserId td,
+ "title" .= todoTitle td,
+ "due_date" .= todoDueDate td,
+ "completed" .= todoCompleted td,
+ "created_at" .= todoCreatedAt td
+ ]
+
+instance Aeson.FromJSON Todo where
+ parseJSON =
+ Aeson.withObject "Todo" <| \v ->
+ (Todo </ (v .: "id"))
+ <*> (v .: "user_id")
+ <*> (v .: "title")
+ <*> (v .:? "due_date")
+ <*> (v .: "completed")
+ <*> (v .: "created_at")
+
+instance SQL.FromRow Todo where
+ fromRow =
+ (Todo </ SQL.field)
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+ <*> SQL.field
+
+initTodosTable :: SQL.Connection -> IO ()
+initTodosTable conn = do
+ SQL.execute_
+ conn
+ "CREATE TABLE IF NOT EXISTS todos (\
+ \ id INTEGER PRIMARY KEY AUTOINCREMENT,\
+ \ user_id TEXT NOT NULL,\
+ \ title TEXT NOT NULL,\
+ \ due_date TIMESTAMP,\
+ \ completed INTEGER NOT NULL DEFAULT 0,\
+ \ created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\
+ \)"
+ SQL.execute_
+ conn
+ "CREATE INDEX IF NOT EXISTS idx_todos_user ON todos(user_id)"
+ SQL.execute_
+ conn
+ "CREATE INDEX IF NOT EXISTS idx_todos_due ON todos(user_id, due_date)"
+
+parseDueDate :: Text -> Maybe UTCTime
+parseDueDate txt =
+ let s = Text.unpack txt
+ in parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M" s
+ <|> parseTimeM True defaultTimeLocale "%Y-%m-%d" s
+ <|> parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S" s
+ <|> parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" s
+
+createTodo :: Text -> Text -> Maybe Text -> IO Todo
+createTodo uid title maybeDueDateStr = do
+ now <- getCurrentTime
+ let dueDate = maybeDueDateStr +> parseDueDate
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.execute
+ conn
+ "INSERT INTO todos (user_id, title, due_date, completed, created_at) VALUES (?, ?, ?, 0, ?)"
+ (uid, title, dueDate, now)
+ rowId <- SQL.lastInsertRowId conn
+ pure
+ Todo
+ { todoId = fromIntegral rowId,
+ todoUserId = uid,
+ todoTitle = title,
+ todoDueDate = dueDate,
+ todoCompleted = False,
+ todoCreatedAt = now
+ }
+
+listTodos :: Text -> Int -> IO [Todo]
+listTodos uid limit =
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.query
+ conn
+ "SELECT id, user_id, title, due_date, completed, created_at \
+ \FROM todos WHERE user_id = ? \
+ \ORDER BY completed ASC, due_date ASC NULLS LAST, created_at DESC LIMIT ?"
+ (uid, limit)
+
+listPendingTodos :: Text -> Int -> IO [Todo]
+listPendingTodos uid limit =
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.query
+ conn
+ "SELECT id, user_id, title, due_date, completed, created_at \
+ \FROM todos WHERE user_id = ? AND completed = 0 \
+ \ORDER BY due_date ASC NULLS LAST, created_at DESC LIMIT ?"
+ (uid, limit)
+
+listOverdueTodos :: Text -> IO [Todo]
+listOverdueTodos uid = do
+ now <- getCurrentTime
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.query
+ conn
+ "SELECT id, user_id, title, due_date, completed, created_at \
+ \FROM todos WHERE user_id = ? AND completed = 0 AND due_date < ? \
+ \ORDER BY due_date ASC"
+ (uid, now)
+
+completeTodo :: Text -> Int -> IO Bool
+completeTodo uid tid =
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.execute
+ conn
+ "UPDATE todos SET completed = 1 WHERE id = ? AND user_id = ?"
+ (tid, uid)
+ changes <- SQL.changes conn
+ pure (changes > 0)
+
+deleteTodo :: Text -> Int -> IO Bool
+deleteTodo uid tid =
+ Memory.withMemoryDb <| \conn -> do
+ initTodosTable conn
+ SQL.execute
+ conn
+ "DELETE FROM todos WHERE id = ? AND user_id = ?"
+ (tid, uid)
+ changes <- SQL.changes conn
+ pure (changes > 0)
+
+todoAddTool :: Text -> Engine.Tool
+todoAddTool uid =
+ Engine.Tool
+ { Engine.toolName = "todo_add",
+ Engine.toolDescription =
+ "Add a todo item with optional due date. Use for tasks, reminders, "
+ <> "or anything the user needs to remember to do. "
+ <> "Due date format: 'YYYY-MM-DD' or 'YYYY-MM-DD HH:MM'.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "title"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("What needs to be done" :: Text)
+ ],
+ "due_date"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("Optional due date: 'YYYY-MM-DD' or 'YYYY-MM-DD HH:MM'" :: Text)
+ ]
+ ],
+ "required" .= (["title"] :: [Text])
+ ],
+ Engine.toolExecute = executeTodoAdd uid
+ }
+
+executeTodoAdd :: Text -> Aeson.Value -> IO Aeson.Value
+executeTodoAdd uid v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e])
+ Aeson.Success (args :: TodoAddArgs) -> do
+ td <- createTodo uid (taTitle args) (taDueDate args)
+ let dueDateMsg = case todoDueDate td of
+ Just d -> " (due: " <> tshow d <> ")"
+ Nothing -> ""
+ pure
+ ( Aeson.object
+ [ "success" .= True,
+ "todo_id" .= todoId td,
+ "message" .= ("Added todo: " <> todoTitle td <> dueDateMsg)
+ ]
+ )
+
+data TodoAddArgs = TodoAddArgs
+ { taTitle :: Text,
+ taDueDate :: Maybe Text
+ }
+ deriving (Generic)
+
+instance Aeson.FromJSON TodoAddArgs where
+ parseJSON =
+ Aeson.withObject "TodoAddArgs" <| \v ->
+ (TodoAddArgs </ (v .: "title"))
+ <*> (v .:? "due_date")
+
+todoListTool :: Text -> Engine.Tool
+todoListTool uid =
+ Engine.Tool
+ { Engine.toolName = "todo_list",
+ Engine.toolDescription =
+ "List todos. By default shows pending (incomplete) todos. "
+ <> "Can show all todos or just overdue ones.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "filter"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("Filter: 'pending' (default), 'all', or 'overdue'" :: Text)
+ ],
+ "limit"
+ .= Aeson.object
+ [ "type" .= ("integer" :: Text),
+ "description" .= ("Max todos to return (default: 20)" :: Text)
+ ]
+ ],
+ "required" .= ([] :: [Text])
+ ],
+ Engine.toolExecute = executeTodoList uid
+ }
+
+executeTodoList :: Text -> Aeson.Value -> IO Aeson.Value
+executeTodoList uid v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e])
+ Aeson.Success (args :: TodoListArgs) -> do
+ let lim = min 50 (max 1 (tlLimit args))
+ todos <- case tlFilter args of
+ "all" -> listTodos uid lim
+ "overdue" -> listOverdueTodos uid
+ _ -> listPendingTodos uid lim
+ pure
+ ( Aeson.object
+ [ "success" .= True,
+ "count" .= length todos,
+ "todos" .= formatTodosForLLM todos
+ ]
+ )
+
+formatTodosForLLM :: [Todo] -> Text
+formatTodosForLLM [] = "No todos found."
+formatTodosForLLM todos =
+ Text.unlines (map formatTodo todos)
+ where
+ formatTodo td =
+ let status = if todoCompleted td then "[x]" else "[ ]"
+ dueStr = case todoDueDate td of
+ Just d -> " (due: " <> Text.pack (show d) <> ")"
+ Nothing -> ""
+ in status <> " " <> todoTitle td <> dueStr <> " (id: " <> tshow (todoId td) <> ")"
+
+data TodoListArgs = TodoListArgs
+ { tlFilter :: Text,
+ tlLimit :: Int
+ }
+ deriving (Generic)
+
+instance Aeson.FromJSON TodoListArgs where
+ parseJSON =
+ Aeson.withObject "TodoListArgs" <| \v ->
+ (TodoListArgs </ (v .:? "filter" .!= "pending"))
+ <*> (v .:? "limit" .!= 20)
+
+todoCompleteTool :: Text -> Engine.Tool
+todoCompleteTool uid =
+ Engine.Tool
+ { Engine.toolName = "todo_complete",
+ Engine.toolDescription =
+ "Mark a todo as completed. Use when the user says they finished something.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "todo_id"
+ .= Aeson.object
+ [ "type" .= ("integer" :: Text),
+ "description" .= ("The ID of the todo to complete" :: Text)
+ ]
+ ],
+ "required" .= (["todo_id"] :: [Text])
+ ],
+ Engine.toolExecute = executeTodoComplete uid
+ }
+
+executeTodoComplete :: Text -> Aeson.Value -> IO Aeson.Value
+executeTodoComplete uid v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e])
+ Aeson.Success (args :: TodoCompleteArgs) -> do
+ completed <- completeTodo uid (tcTodoId args)
+ if completed
+ then
+ pure
+ ( Aeson.object
+ [ "success" .= True,
+ "message" .= ("Todo marked as complete" :: Text)
+ ]
+ )
+ else
+ pure
+ ( Aeson.object
+ [ "success" .= False,
+ "error" .= ("Todo not found" :: Text)
+ ]
+ )
+
+newtype TodoCompleteArgs = TodoCompleteArgs
+ { tcTodoId :: Int
+ }
+ deriving (Generic)
+
+instance Aeson.FromJSON TodoCompleteArgs where
+ parseJSON =
+ Aeson.withObject "TodoCompleteArgs" <| \v ->
+ TodoCompleteArgs </ (v .: "todo_id")
+
+todoDeleteTool :: Text -> Engine.Tool
+todoDeleteTool uid =
+ Engine.Tool
+ { Engine.toolName = "todo_delete",
+ Engine.toolDescription =
+ "Delete a todo permanently. Use when a todo is no longer needed.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "todo_id"
+ .= Aeson.object
+ [ "type" .= ("integer" :: Text),
+ "description" .= ("The ID of the todo to delete" :: Text)
+ ]
+ ],
+ "required" .= (["todo_id"] :: [Text])
+ ],
+ Engine.toolExecute = executeTodoDelete uid
+ }
+
+executeTodoDelete :: Text -> Aeson.Value -> IO Aeson.Value
+executeTodoDelete uid v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e])
+ Aeson.Success (args :: TodoDeleteArgs) -> do
+ deleted <- deleteTodo uid (tdTodoId args)
+ if deleted
+ then
+ pure
+ ( Aeson.object
+ [ "success" .= True,
+ "message" .= ("Todo deleted" :: Text)
+ ]
+ )
+ else
+ pure
+ ( Aeson.object
+ [ "success" .= False,
+ "error" .= ("Todo not found" :: Text)
+ ]
+ )
+
+newtype TodoDeleteArgs = TodoDeleteArgs
+ { tdTodoId :: Int
+ }
+ deriving (Generic)
+
+instance Aeson.FromJSON TodoDeleteArgs where
+ parseJSON =
+ Aeson.withObject "TodoDeleteArgs" <| \v ->
+ TodoDeleteArgs </ (v .: "todo_id")