summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Agent/Worker.hs2
-rw-r--r--Omni/Jr/Web.hs29
-rw-r--r--Omni/Task.hs70
-rw-r--r--Omni/Task/Core.hs56
4 files changed, 129 insertions, 28 deletions
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index 50ad2ae..62ad4da 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -318,7 +318,7 @@ formatTask t =
<> "Updated: "
<> Text.pack (show (TaskCore.taskUpdatedAt t))
<> "\n"
- <> maybe "" (\d -> "Description:\n" <> d <> "\n\n") (TaskCore.taskDescription t)
+ <> (if Text.null (TaskCore.taskDescription t) then "" else "Description:\n" <> TaskCore.taskDescription t <> "\n\n")
<> (if null (TaskCore.taskDependencies t) then "" else "\nDependencies:\n" <> Text.unlines (map formatDep (TaskCore.taskDependencies t)))
where
formatDep dep = " - " <> TaskCore.depId dep <> " [" <> Text.pack (show (TaskCore.depType dep)) <> "]"
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index fbb56a7..a861944 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -879,10 +879,8 @@ renderEpicCardWithStats allTasks t =
Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount
- case TaskCore.taskDescription t of
- Nothing -> pure ()
- Just desc ->
- Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "..."))
+ unless (Text.null (TaskCore.taskDescription t))
+ <| Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 (TaskCore.taskDescription t) <> "..."))
getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task]
getDescendants allTasks parentId =
@@ -1045,9 +1043,9 @@ instance Lucid.ToHtml TaskDetailPage where
for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
Lucid.div_ [Lucid.class_ "detail-section"] <| do
Lucid.h3_ "Design"
- case TaskCore.taskDescription task of
- Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
- Just desc -> Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
+ if Text.null (TaskCore.taskDescription task)
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
+ else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown (TaskCore.taskDescription task))
Lucid.details_ [Lucid.class_ "edit-description"] <| do
Lucid.summary_ "Edit Design"
Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description")] <| do
@@ -1057,16 +1055,15 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.rows_ "15",
Lucid.placeholder_ "Enter design in Markdown format..."
]
- (Lucid.toHtml (fromMaybe "" (TaskCore.taskDescription task)))
+ (Lucid.toHtml (TaskCore.taskDescription task))
Lucid.div_ [Lucid.class_ "form-actions"] <| do
Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Design"
_ ->
- case TaskCore.taskDescription task of
- Nothing -> pure ()
- Just desc ->
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Description"
- Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc)
+ unless (Text.null (TaskCore.taskDescription task))
+ <| Lucid.div_ [Lucid.class_ "detail-section"]
+ <| do
+ Lucid.h3_ "Description"
+ Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml (TaskCore.taskDescription task))
let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
unless (null children) <| do
@@ -2027,8 +2024,8 @@ server =
taskDescriptionHandler :: Text -> DescriptionForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
taskDescriptionHandler tid (DescriptionForm desc) = do
- let descMaybe = if Text.null (Text.strip desc) then Nothing else Just desc
- _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descMaybe})
+ let descText = Text.strip desc
+ _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
pure <| addHeader ("/tasks/" <> tid) NoContent
taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
diff --git a/Omni/Task.hs b/Omni/Task.hs
index 5e0595b..bf262ab 100644
--- a/Omni/Task.hs
+++ b/Omni/Task.hs
@@ -45,6 +45,7 @@ Usage:
task create <title> [options]
task edit <id> [options]
task delete <id> [--json]
+ task comment <id> <message> [--json]
task list [options]
task ready [--json]
task show <id> [--json]
@@ -63,6 +64,7 @@ Commands:
create Create a new task or epic
edit Edit an existing task
delete Delete a task
+ comment Add a comment to a task
list List all tasks
ready Show ready tasks (not blocked)
show Show detailed task information
@@ -100,6 +102,7 @@ Arguments:
<title> Task title
<id> Task ID
<status> Task status (draft, open, in-progress, review, approved, done)
+ <message> Comment message
<file> JSONL file to import
|]
@@ -259,6 +262,13 @@ move' args
if isJsonMode args
then outputSuccess ("Deleted task " <> tid)
else putStrLn <| "Deleted task: " <> T.unpack tid
+ | args `Cli.has` Cli.command "comment" = do
+ tid <- getArgText args "id"
+ message <- getArgText args "message"
+ updatedTask <- addComment tid message
+ if isJsonMode args
+ then outputJson updatedTask
+ else putStrLn <| "Added comment to task: " <> T.unpack tid
| args `Cli.has` Cli.command "list" = do
maybeType <- case Cli.getArg args (Cli.longOption "type") of
Nothing -> pure Nothing
@@ -539,9 +549,10 @@ unitTests =
taskStatus = Open,
taskPriority = P2,
taskDependencies = [],
+ taskDescription = "Child 3",
+ taskComments = [],
taskCreatedAt = taskCreatedAt child1,
- taskUpdatedAt = taskUpdatedAt child1,
- taskDescription = "Child 3"
+ taskUpdatedAt = taskUpdatedAt child1
}
saveTask child3
@@ -601,7 +612,7 @@ unitTests =
Test.unit "can create task with lowercase ID" <| do
-- This verifies that lowercase IDs are accepted and not rejected
let lowerId = "t-lowercase"
- let task = Task lowerId "Lower" WorkTask Nothing Nothing Open P2 [] "Lower description" (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task = Task lowerId "Lower" WorkTask Nothing Nothing Open P2 [] "Lower description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
saveTask task
tasks <- loadTasks
case findTask lowerId tasks of
@@ -609,7 +620,7 @@ unitTests =
Nothing -> Test.assertFailure "Should find task with lowercase ID",
Test.unit "generateId produces valid ID" <| do
tid <- generateId
- let task = Task tid "Auto" WorkTask Nothing Nothing Open P2 [] "Auto description" (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task = Task tid "Auto" WorkTask Nothing Nothing Open P2 [] "Auto description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
saveTask task
tasks <- loadTasks
case findTask tid tasks of
@@ -633,7 +644,7 @@ unitTests =
Test.unit "lowercase ID does not clash with existing uppercase ID" <| do
-- Setup: Create task with Uppercase ID
let upperId = "t-UPPER"
- let task1 = Task upperId "Upper Task" WorkTask Nothing Nothing Open P2 [] "Upper description" (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
+ let task1 = Task upperId "Upper Task" WorkTask Nothing Nothing Open P2 [] "Upper description" [] (read "2025-01-01 00:00:00 UTC") (read "2025-01-01 00:00:00 UTC")
saveTask task1
-- Action: Try to create task with Lowercase ID (same letters)
@@ -644,7 +655,7 @@ unitTests =
-- treating them as the same is dangerous.
let lowerId = "t-upper"
- let task2 = Task lowerId "Lower Task" WorkTask Nothing Nothing Open P2 [] "Lower description" (read "2025-01-01 00:00:01 UTC") (read "2025-01-01 00:00:01 UTC")
+ let task2 = Task lowerId "Lower Task" WorkTask Nothing Nothing Open P2 [] "Lower description" [] (read "2025-01-01 00:00:01 UTC") (read "2025-01-01 00:00:01 UTC")
saveTask task2
tasks <- loadTasks
@@ -684,7 +695,35 @@ unitTests =
Test.unit "FromHttpApiData Status: valid values parse correctly" <| do
(parseQueryParam "Open" :: Either Text Status) Test.@?= Right Open
(parseQueryParam "InProgress" :: Either Text Status) Test.@?= Right InProgress
- (parseQueryParam "Done" :: Either Text Status) Test.@?= Right Done
+ (parseQueryParam "Done" :: Either Text Status) Test.@?= Right Done,
+ Test.unit "can add comment to task" <| do
+ task <- createTask "Task with comment" WorkTask Nothing Nothing P2 [] "Description"
+ updatedTask <- addComment (taskId task) "This is a test comment"
+ length (taskComments updatedTask) Test.@?= 1
+ case taskComments updatedTask of
+ (c : _) -> commentText c Test.@?= "This is a test comment"
+ [] -> Test.assertFailure "Expected at least one comment",
+ Test.unit "can add multiple comments to task" <| do
+ task <- createTask "Task with comments" WorkTask Nothing Nothing P2 [] "Description"
+ _ <- addComment (taskId task) "First comment"
+ updatedTask <- addComment (taskId task) "Second comment"
+ length (taskComments updatedTask) Test.@?= 2
+ case taskComments updatedTask of
+ (c1 : c2 : _) -> do
+ commentText c1 Test.@?= "First comment"
+ commentText c2 Test.@?= "Second comment"
+ _ -> Test.assertFailure "Expected at least two comments",
+ Test.unit "comments are persisted" <| do
+ task <- createTask "Persistent comments" WorkTask Nothing Nothing P2 [] "Description"
+ _ <- addComment (taskId task) "Persisted comment"
+ tasks <- loadTasks
+ case findTask (taskId task) tasks of
+ Nothing -> Test.assertFailure "Could not reload task"
+ Just reloaded -> do
+ length (taskComments reloaded) Test.@?= 1
+ case taskComments reloaded of
+ (c : _) -> commentText c Test.@?= "Persisted comment"
+ [] -> Test.assertFailure "Expected at least one comment"
]
-- | Test CLI argument parsing to ensure docopt string matches actual usage
@@ -918,5 +957,20 @@ cliTests =
args `Cli.has` Cli.command "create" Test.@?= True
args `Cli.has` Cli.longOption "json" Test.@?= True
Cli.getArg args (Cli.longOption "priority") Test.@?= Just "1"
- Cli.getArg args (Cli.longOption "namespace") Test.@?= Just "Omni/Task"
+ Cli.getArg args (Cli.longOption "namespace") Test.@?= Just "Omni/Task",
+ Test.unit "comment command" <| do
+ let result = Docopt.parseArgs help ["comment", "t-abc123", "This is a comment"]
+ case result of
+ Left err -> Test.assertFailure <| "Failed to parse 'comment': " <> show err
+ Right args -> do
+ args `Cli.has` Cli.command "comment" Test.@?= True
+ Cli.getArg args (Cli.argument "id") Test.@?= Just "t-abc123"
+ Cli.getArg args (Cli.argument "message") Test.@?= Just "This is a comment",
+ Test.unit "comment with --json flag" <| do
+ let result = Docopt.parseArgs help ["comment", "t-abc123", "Test comment", "--json"]
+ case result of
+ Left err -> Test.assertFailure <| "Failed to parse 'comment --json': " <> show err
+ Right args -> do
+ args `Cli.has` Cli.command "comment" Test.@?= True
+ args `Cli.has` Cli.longOption "json" Test.@?= True
]
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 18f80e2..1be97b9 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -36,6 +36,7 @@ data Task = Task
taskPriority :: Priority, -- Priority level (0-4)
taskDependencies :: [Dependency], -- List of dependencies with types
taskDescription :: Text, -- Required description
+ taskComments :: [Comment], -- Timestamped comments for extra context
taskCreatedAt :: UTCTime,
taskUpdatedAt :: UTCTime
}
@@ -123,6 +124,13 @@ data Fact = Fact
}
deriving (Show, Eq, Generic)
+-- Comment for task notes/context
+data Comment = Comment
+ { commentText :: Text,
+ commentCreatedAt :: UTCTime
+ }
+ deriving (Show, Eq, Generic)
+
instance ToJSON TaskType
instance FromJSON TaskType
@@ -171,6 +179,10 @@ instance ToJSON Fact
instance FromJSON Fact
+instance ToJSON Comment
+
+instance FromJSON Comment
+
-- HTTP API Instances (for Servant query params)
instance FromHttpApiData Status where
@@ -240,6 +252,17 @@ instance SQL.FromField [Dependency] where
instance SQL.ToField [Dependency] where
toField deps = SQL.toField (BLC.unpack (encode deps))
+-- Store comments as JSON text
+instance SQL.FromField [Comment] where
+ fromField f = do
+ t <- SQL.fromField f :: SQLOk.Ok String
+ case Aeson.decode (BLC.pack t) of
+ Just x -> pure x
+ Nothing -> pure [] -- Default to empty if parse fail or null
+
+instance SQL.ToField [Comment] where
+ toField comments = SQL.toField (BLC.unpack (encode comments))
+
instance SQL.FromRow Task where
fromRow =
Task
@@ -252,6 +275,7 @@ instance SQL.FromRow Task where
<*> SQL.field
<*> SQL.field
<*> (fromMaybe "" </ SQL.field) -- Handle NULL description from legacy data
+ <*> SQL.field -- comments
<*> SQL.field
<*> SQL.field
@@ -266,6 +290,7 @@ instance SQL.ToRow Task where
SQL.toField (taskPriority t),
SQL.toField (taskDependencies t),
SQL.toField (taskDescription t),
+ SQL.toField (taskComments t),
SQL.toField (taskCreatedAt t),
SQL.toField (taskUpdatedAt t)
]
@@ -402,6 +427,7 @@ initTaskDb = do
\ priority TEXT NOT NULL, \
\ dependencies TEXT NOT NULL, \
\ description TEXT, \
+ \ comments TEXT NOT NULL DEFAULT '[]', \
\ created_at TIMESTAMP NOT NULL, \
\ updated_at TIMESTAMP NOT NULL \
\)"
@@ -488,6 +514,7 @@ tasksColumns =
("priority", "TEXT"),
("dependencies", "TEXT"),
("description", "TEXT"),
+ ("comments", "TEXT"),
("created_at", "TIMESTAMP"),
("updated_at", "TIMESTAMP")
]
@@ -584,7 +611,7 @@ getSuffix parent childId =
loadTasks :: IO [Task]
loadTasks =
withDb <| \conn -> do
- SQL.query_ conn "SELECT id, title, type, parent, namespace, status, priority, dependencies, description, created_at, updated_at FROM tasks"
+ SQL.query_ conn "SELECT id, title, type, parent, namespace, status, priority, dependencies, description, comments, created_at, updated_at FROM tasks"
-- Save a single task (UPSERT)
saveTask :: Task -> IO ()
@@ -593,8 +620,8 @@ saveTask task =
SQL.execute
conn
"INSERT OR REPLACE INTO tasks \
- \ (id, title, type, parent, namespace, status, priority, dependencies, description, created_at, updated_at) \
- \ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
+ \ (id, title, type, parent, namespace, status, priority, dependencies, description, comments, created_at, updated_at) \
+ \ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
task
-- Create a new task
@@ -621,6 +648,7 @@ createTask title taskType parent namespace priority deps description =
taskPriority = priority,
taskDependencies = deps',
taskDescription = description,
+ taskComments = [],
taskCreatedAt = now,
taskUpdatedAt = now
}
@@ -681,6 +709,20 @@ deleteTask tid =
withDb <| \conn ->
SQL.execute conn "DELETE FROM tasks WHERE id = ?" (SQL.Only tid)
+-- Add a comment to a task
+addComment :: Text -> Text -> IO Task
+addComment tid commentText =
+ withTaskLock <| do
+ tasks <- loadTasks
+ case findTask tid tasks of
+ Nothing -> panic "Task not found"
+ Just task -> do
+ now <- getCurrentTime
+ let newComment = Comment {commentText = commentText, commentCreatedAt = now}
+ updatedTask = task {taskComments = taskComments task ++ [newComment], taskUpdatedAt = now}
+ saveTask updatedTask
+ pure updatedTask
+
-- List tasks
listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task]
listTasks maybeType maybeParent maybeStatus maybeNamespace = do
@@ -963,6 +1005,11 @@ showTaskDetailed t = do
let indented = T.unlines <| map (" " <>) (T.lines (taskDescription t))
putText indented
+ unless (null (taskComments t)) <| do
+ putText ""
+ putText "Comments:"
+ traverse_ printComment (taskComments t)
+
putText ""
where
priorityDesc = case taskPriority t of
@@ -975,6 +1022,9 @@ showTaskDetailed t = do
printDependency dep =
putText <| " - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]"
+ printComment c =
+ putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] " <> commentText c
+
red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text
red t = "\ESC[31m" <> t <> "\ESC[0m"
green t = "\ESC[32m" <> t <> "\ESC[0m"
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 21:15:10 +0000