commit 4919cf825d4fdbcecc1f69fcf2a32176dfdde5ac
Author: Ben Sima <ben@bensima.com>
Date: Mon Dec 1 07:40:49 2025
Add author field to task comments (Human vs Junior)
Comments now track whether they were made by a Human or by Junior
(the agent). The CommentAuthor type is stored in the database and
displayed in the web UI with styled badges.
Task-Id: t-201
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
index a5bc48b1..dc6ded0b 100755
--- a/Omni/Jr.hs
+++ b/Omni/Jr.hs
@@ -232,7 +232,7 @@ handleConflict tid conflictFiles commitSha = do
let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx
let conflictComment = buildConflictComment commitSha conflictFiles attempt
- _ <- TaskCore.addComment tid conflictComment
+ _ <- TaskCore.addComment tid conflictComment TaskCore.Junior
if attempt > 3
then do
@@ -419,7 +419,7 @@ autoReview tid task commitSha = do
Exit.ExitSuccess -> do
putText "[review] ✓ Tests passed."
let reviewComment = buildReviewComment commitSha testTarget True testOut testErr
- _ <- TaskCore.addComment tid reviewComment
+ _ <- TaskCore.addComment tid reviewComment TaskCore.Junior
TaskCore.clearRetryContext tid
TaskCore.updateTaskStatus tid TaskCore.Done []
putText ("[review] Task " <> tid <> " -> Done")
@@ -434,7 +434,7 @@ autoReview tid task commitSha = do
let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
let reviewComment = buildReviewComment commitSha testTarget False testOut testErr
- _ <- TaskCore.addComment tid reviewComment
+ _ <- TaskCore.addComment tid reviewComment TaskCore.Junior
if attempt > 3
then do
@@ -500,7 +500,7 @@ interactiveReview tid task commitSha = do
c
| "a" `Text.isPrefixOf` c -> do
let acceptComment = buildHumanReviewComment commitSha True Nothing
- _ <- TaskCore.addComment tid acceptComment
+ _ <- TaskCore.addComment tid acceptComment TaskCore.Human
TaskCore.clearRetryContext tid
TaskCore.updateTaskStatus tid TaskCore.Done []
putText ("Task " <> tid <> " marked as Done.")
@@ -512,7 +512,7 @@ interactiveReview tid task commitSha = do
IO.hFlush IO.stdout
reason <- getLine
let rejectComment = buildHumanReviewComment commitSha False (Just reason)
- _ <- TaskCore.addComment tid rejectComment
+ _ <- TaskCore.addComment tid rejectComment TaskCore.Human
maybeCtx <- TaskCore.getRetryContext tid
let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> reason
@@ -620,7 +620,7 @@ addCompletionSummary tid commitSha = do
Right msg -> do
let summary = Text.strip (Engine.msgContent msg)
unless (Text.null summary) <| do
- _ <- TaskCore.addComment tid ("## Completion Summary\n\n" <> summary)
+ _ <- TaskCore.addComment tid ("## Completion Summary\n\n" <> summary) TaskCore.Junior
putText "[review] Added completion summary comment"
-- | Build prompt for LLM to generate completion summary
@@ -753,7 +753,7 @@ generateEpicSummary epicId epic children = do
putText ("[epic] Failed to generate summary: " <> err)
Right msg -> do
let summary = Engine.msgContent msg
- _ <- TaskCore.addComment epicId summary
+ _ <- TaskCore.addComment epicId summary TaskCore.Junior
putText "[epic] Summary comment added to epic"
-- | Build a prompt for the LLM to summarize an epic
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 88e04425..d1914544 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -1624,7 +1624,16 @@ instance Lucid.ToHtml TaskDetailPage where
renderComment currentTime c =
Lucid.div_ [Lucid.class_ "comment-card"] <| do
Lucid.p_ [Lucid.class_ "comment-text"] (Lucid.toHtml (TaskCore.commentText c))
- Lucid.span_ [Lucid.class_ "comment-time"] (renderRelativeTimestamp currentTime (TaskCore.commentCreatedAt c))
+ Lucid.div_ [Lucid.class_ "comment-meta"] <| do
+ Lucid.span_ [Lucid.class_ ("comment-author " <> authorClass)] (Lucid.toHtml (authorLabel (TaskCore.commentAuthor c)))
+ Lucid.span_ [Lucid.class_ "comment-time"] (renderRelativeTimestamp currentTime (TaskCore.commentCreatedAt c))
+ where
+ authorClass = case TaskCore.commentAuthor c of
+ TaskCore.Human -> "author-human"
+ TaskCore.Junior -> "author-junior"
+ authorLabel author = case author of
+ TaskCore.Human -> "Human" :: Text
+ TaskCore.Junior -> "Junior" :: Text
commentForm :: (Monad m) => Text -> Lucid.HtmlT m ()
commentForm tid =
@@ -2880,7 +2889,7 @@ server =
taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
taskCommentHandler tid (CommentForm commentText) = do
- _ <- liftIO (TaskCore.addComment tid commentText)
+ _ <- liftIO (TaskCore.addComment tid commentText TaskCore.Human)
pure <| addHeader ("/tasks/" <> tid) NoContent
taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index 00d66c26..86a3729d 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -1276,6 +1276,24 @@ commentStyles = do
fontSize (px 13)
color "#374151"
whiteSpace preWrap
+ ".comment-meta" ? do
+ display flex
+ alignItems center
+ Stylesheet.key "gap" ("8px" :: Text)
+ ".comment-author" ? do
+ display inlineBlock
+ padding (px 2) (px 6) (px 2) (px 6)
+ borderRadius (px 2) (px 2) (px 2) (px 2)
+ fontSize (px 10)
+ fontWeight (weight 600)
+ textTransform uppercase
+ whiteSpace nowrap
+ ".author-human" ? do
+ backgroundColor "#dbeafe"
+ color "#1e40af"
+ ".author-junior" ? do
+ backgroundColor "#d1fae5"
+ color "#065f46"
".comment-time" ? do
fontSize (px 11)
color "#9ca3af"
@@ -1825,6 +1843,12 @@ darkModeStyles =
backgroundColor "#374151"
borderColor "#4b5563"
".comment-text" ? color "#d1d5db"
+ ".author-human" ? do
+ backgroundColor "#1e3a8a"
+ color "#93c5fd"
+ ".author-junior" ? do
+ backgroundColor "#064e3b"
+ color "#6ee7b7"
".comment-time" ? color "#9ca3af"
".comment-textarea" ? do
backgroundColor "#374151"
diff --git a/Omni/Task.hs b/Omni/Task.hs
index 11d080b8..3a68fa5b 100644
--- a/Omni/Task.hs
+++ b/Omni/Task.hs
@@ -286,7 +286,7 @@ move' args
| args `Cli.has` Cli.command "comment" = do
tid <- getArgText args "id"
message <- getArgText args "message"
- updatedTask <- addComment tid message
+ updatedTask <- addComment tid message Human
if isJsonMode args
then outputJson updatedTask
else putStrLn <| "Added comment to task: " <> T.unpack tid
@@ -873,24 +873,28 @@ unitTests =
(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 Nothing [] "Description"
- updatedTask <- addComment (taskId task) "This is a test comment"
+ updatedTask <- addComment (taskId task) "This is a test comment" Human
length (taskComments updatedTask) Test.@?= 1
case taskComments updatedTask of
- (c : _) -> commentText c Test.@?= "This is a test comment"
+ (c : _) -> do
+ commentText c Test.@?= "This is a test comment"
+ commentAuthor c Test.@?= Human
[] -> 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 Nothing [] "Description"
- _ <- addComment (taskId task) "First comment"
- updatedTask <- addComment (taskId task) "Second comment"
+ _ <- addComment (taskId task) "First comment" Junior
+ updatedTask <- addComment (taskId task) "Second comment" Human
length (taskComments updatedTask) Test.@?= 2
case taskComments updatedTask of
(c1 : c2 : _) -> do
commentText c1 Test.@?= "First comment"
+ commentAuthor c1 Test.@?= Junior
commentText c2 Test.@?= "Second comment"
+ commentAuthor c2 Test.@?= Human
_ -> Test.assertFailure "Expected at least two comments",
Test.unit "comments are persisted" <| do
task <- createTask "Persistent comments" WorkTask Nothing Nothing P2 Nothing [] "Description"
- _ <- addComment (taskId task) "Persisted comment"
+ _ <- addComment (taskId task) "Persisted comment" Junior
tasks <- loadTasks
case findTask (taskId task) tasks of
Nothing -> Test.assertFailure "Could not reload task"
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 6a6d1b87..f54cf81e 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -140,9 +140,14 @@ data Fact = Fact
}
deriving (Show, Eq, Generic)
+-- Comment author
+data CommentAuthor = Human | Junior
+ deriving (Show, Eq, Read, Generic)
+
-- Comment for task notes/context
data Comment = Comment
{ commentText :: Text,
+ commentAuthor :: CommentAuthor,
commentCreatedAt :: UTCTime
}
deriving (Show, Eq, Generic)
@@ -195,6 +200,10 @@ instance ToJSON Fact
instance FromJSON Fact
+instance ToJSON CommentAuthor
+
+instance FromJSON CommentAuthor
+
instance ToJSON Comment
instance FromJSON Comment
@@ -257,6 +266,16 @@ instance SQL.FromField ActivityStage where
instance SQL.ToField ActivityStage where
toField x = SQL.toField (show x :: String)
+instance SQL.FromField CommentAuthor where
+ fromField f = do
+ t <- SQL.fromField f :: SQLOk.Ok String
+ case readMaybe t of
+ Just x -> pure x
+ Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid CommentAuthor"
+
+instance SQL.ToField CommentAuthor where
+ toField x = SQL.toField (show x :: String)
+
-- Store dependencies as JSON text
instance SQL.FromField [Dependency] where
fromField f = do
@@ -752,15 +771,15 @@ deleteTask tid =
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 =
+addComment :: Text -> Text -> CommentAuthor -> IO Task
+addComment tid commentText author =
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}
+ let newComment = Comment {commentText = commentText, commentAuthor = author, commentCreatedAt = now}
updatedTask = task {taskComments = taskComments task ++ [newComment], taskUpdatedAt = now}
saveTask updatedTask
pure updatedTask
@@ -1068,7 +1087,7 @@ showTaskDetailed t = do
putText <| " - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]"
printComment c =
- putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] " <> commentText c
+ putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] [" <> T.pack (show (commentAuthor c)) <> "] " <> commentText c
red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text
red t = "\ESC[31m" <> t <> "\ESC[0m"