commit 3215b7de9b644c47a7974e6efe3a203c61b90721
Author: Ben Sima <ben@bensima.com>
Date: Wed Dec 31 23:57:28 2025
Omni/Task/Core.hs: Add Role to CommentAuthor for agent comments
Refactor CommentAuthor to support agent roles:
- Add Role type: ProductMgr, Designer, Engineer, Reviewer
- Change CommentAuthor from Human | Junior | System to Human | Agent Role | System
- Custom JSON instances for Role using lowercase strings (product, designer, etc.)
- Custom JSON/SQLite instances for CommentAuthor with backward compat (junior -> Agent Engineer)
- Add --role flag to task comment CLI command
- Update formatAuthor for nice display in task show
Task-Id: t-306
diff --git a/Omni/Task.hs b/Omni/Task.hs
index 5df28480..62765acd 100644
--- a/Omni/Task.hs
+++ b/Omni/Task.hs
@@ -49,7 +49,7 @@ Usage:
task create <title> [options]
task edit <id> [options]
task delete <id> [--json]
- task comment <id> <message> [--json]
+ task comment <id> <message> [--role=<role>] [--json]
task list [options]
task ready [--json]
task show <id> [--json]
@@ -96,6 +96,7 @@ Options:
--dep-type=<type> Dependency type: blocks, discovered-from, parent-child, related
--discovered-from=<id> Shortcut for --deps=<id> --dep-type=discovered-from
--namespace=<ns> Optional namespace (e.g., Omni/Task, Biz/Cloud)
+ --role=<role> Agent role for comment: product, designer, engineer, reviewer
--description=<desc> Task description
--db=<file> Path to SQLite database (overrides TASK_DB_PATH)
--flush Force immediate export
@@ -288,7 +289,14 @@ move' args
| args `Cli.has` Cli.command "comment" = do
tid <- getArgText args "id"
message <- getArgText args "message"
- updatedTask <- addComment tid message Human
+ let author = case Cli.getArg args (Cli.longOption "role") of
+ Nothing -> Human
+ Just "product" -> Agent ProductMgr
+ Just "designer" -> Agent Designer
+ Just "engineer" -> Agent Engineer
+ Just "reviewer" -> Agent Reviewer
+ Just other -> panic <| "Invalid role: " <> T.pack other <> ". Valid roles: product, designer, engineer, reviewer"
+ updatedTask <- addComment tid message author
if isJsonMode args
then outputJson updatedTask
else putStrLn <| "Added comment to task: " <> T.unpack tid
@@ -897,19 +905,19 @@ unitTests =
[] -> 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" Junior
+ _ <- addComment (taskId task) "First comment" (Agent Engineer)
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
+ commentAuthor c1 Test.@?= Agent Engineer
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" Junior
+ _ <- addComment (taskId task) "Persisted comment" (Agent Engineer)
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 a8880d03..f380eecd 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -141,8 +141,13 @@ data Fact = Fact
}
deriving (Show, Eq, Generic)
+-- Role for agent comments (which perspective the agent was using)
+-- Note: ProductMgr avoids conflict with Alpha.Product from Data.Semigroup
+data Role = ProductMgr | Designer | Engineer | Reviewer
+ deriving (Show, Eq, Read, Generic)
+
-- Comment/event author (also used as Actor for timeline events)
-data CommentAuthor = Human | Junior | System
+data CommentAuthor = Human | Agent Role | System
deriving (Show, Eq, Read, Generic)
-- Comment for task notes/context
@@ -201,9 +206,40 @@ instance ToJSON Fact
instance FromJSON Fact
-instance ToJSON CommentAuthor
-
-instance FromJSON CommentAuthor
+-- Custom JSON instances for Role to use lowercase strings
+instance ToJSON Role where
+ toJSON ProductMgr = Aeson.String "product"
+ toJSON Designer = Aeson.String "designer"
+ toJSON Engineer = Aeson.String "engineer"
+ toJSON Reviewer = Aeson.String "reviewer"
+
+instance FromJSON Role where
+ parseJSON = Aeson.withText "Role" <| \case
+ "product" -> pure ProductMgr
+ "designer" -> pure Designer
+ "engineer" -> pure Engineer
+ "reviewer" -> pure Reviewer
+ other -> fail <| "Unknown role: " <> Text.unpack other
+
+-- Custom JSON instances for CommentAuthor to handle nested Agent structure
+-- JSON format: "human", "system", or {"agent": "product"}
+instance ToJSON CommentAuthor where
+ toJSON Human = Aeson.String "human"
+ toJSON System = Aeson.String "system"
+ toJSON (Agent role) = Aeson.object [("agent", Aeson.toJSON role)]
+
+instance FromJSON CommentAuthor where
+ parseJSON (Aeson.String "human") = pure Human
+ parseJSON (Aeson.String "Human") = pure Human
+ parseJSON (Aeson.String "system") = pure System
+ parseJSON (Aeson.String "System") = pure System
+ -- Backward compatibility: Junior -> Agent Engineer
+ parseJSON (Aeson.String "junior") = pure (Agent Engineer)
+ parseJSON (Aeson.String "Junior") = pure (Agent Engineer)
+ parseJSON (Aeson.Object obj) = case KeyMap.lookup "agent" obj of
+ Just roleVal -> Agent </ Aeson.parseJSON roleVal
+ Nothing -> empty
+ parseJSON _ = empty
instance ToJSON Comment
@@ -1080,7 +1116,15 @@ showTaskDetailed t = do
putText <| " - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]"
printComment c =
- putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] [" <> T.pack (show (commentAuthor c)) <> "] " <> commentText c
+ putText <| " [" <> T.pack (show (commentCreatedAt c)) <> "] [" <> formatAuthor (commentAuthor c) <> "] " <> commentText c
+
+ formatAuthor :: CommentAuthor -> Text
+ formatAuthor Human = "human"
+ formatAuthor System = "system"
+ formatAuthor (Agent ProductMgr) = "product"
+ formatAuthor (Agent Designer) = "designer"
+ formatAuthor (Agent Engineer) = "engineer"
+ formatAuthor (Agent Reviewer) = "reviewer"
red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text
red t = "\ESC[31m" <> t <> "\ESC[0m"
@@ -1351,7 +1395,7 @@ logActivity tid stage metadata = do
sessionId <- getOrCreateCommentSession tid
let eventType = activityStageToEventType stage
content = fromMaybe "" metadata
- insertAgentEvent tid sessionId eventType content Junior
+ insertAgentEvent tid sessionId eventType content (Agent Engineer)
-- | Log activity with worker metrics (timing, cost stored in metadata JSON)
logActivityWithMetrics :: Text -> ActivityStage -> Maybe Text -> Maybe Text -> Maybe UTCTime -> Maybe UTCTime -> Maybe Int -> Maybe Int -> IO Int
@@ -1363,7 +1407,7 @@ logActivityWithMetrics tid stage baseMetadata _ampUrl startedAt completedAt cost
SQL.execute
conn
"INSERT INTO agent_events (task_id, session_id, event_type, content, actor) VALUES (?, ?, ?, ?, ?)"
- (tid, sessionId, eventType, metricsJson, Junior)
+ (tid, sessionId, eventType, metricsJson, Agent Engineer)
[SQL.Only actId] <- SQL.query_ conn "SELECT last_insert_rowid()" :: IO [SQL.Only Int]
pure actId
@@ -1674,14 +1718,23 @@ instance SQL.FromField CommentAuthor where
t <- SQL.fromField f :: SQLOk.Ok String
case t of
"human" -> pure Human
- "junior" -> pure Junior
"system" -> pure System
+ -- Backward compatibility: junior -> Agent Engineer
+ "junior" -> pure (Agent Engineer)
+ -- New agent role formats
+ "agent:product" -> pure (Agent ProductMgr)
+ "agent:designer" -> pure (Agent Designer)
+ "agent:engineer" -> pure (Agent Engineer)
+ "agent:reviewer" -> pure (Agent Reviewer)
_ -> SQL.returnError SQL.ConversionFailed f "Invalid CommentAuthor"
instance SQL.ToField CommentAuthor where
toField Human = SQL.toField ("human" :: String)
- toField Junior = SQL.toField ("junior" :: String)
toField System = SQL.toField ("system" :: String)
+ toField (Agent ProductMgr) = SQL.toField ("agent:product" :: String)
+ toField (Agent Designer) = SQL.toField ("agent:designer" :: String)
+ toField (Agent Engineer) = SQL.toField ("agent:engineer" :: String)
+ toField (Agent Reviewer) = SQL.toField ("agent:reviewer" :: String)
-- | Stored agent event record
data StoredEvent = StoredEvent
@@ -1782,7 +1835,7 @@ getEventsSince sessionId lastId =
-- | Insert a checkpoint event (for progress tracking)
insertCheckpoint :: Text -> Text -> Text -> IO ()
insertCheckpoint taskId sessionId content =
- insertAgentEvent taskId sessionId "Checkpoint" content Junior
+ insertAgentEvent taskId sessionId "Checkpoint" content (Agent Engineer)
-- | Get all checkpoints for a task (across all sessions)
getCheckpointsForTask :: Text -> IO [StoredEvent]
diff --git a/Omni/Task/MigrationTest.hs b/Omni/Task/MigrationTest.hs
index f16f782c..ee8033b7 100644
--- a/Omni/Task/MigrationTest.hs
+++ b/Omni/Task/MigrationTest.hs
@@ -26,14 +26,14 @@ migrationStartupTest =
withDb <| \conn -> do
tasksCols <- getTableColumns conn "tasks"
- activityCols <- getTableColumns conn "task_activity"
+ eventsCols <- getTableColumns conn "agent_events"
retryCols <- getTableColumns conn "retry_context"
Set.fromList ["id", "title", "status"]
`Set.isSubsetOf` Set.fromList tasksCols
Test.@?= True
- Set.fromList ["id", "task_id", "stage"]
- `Set.isSubsetOf` Set.fromList activityCols
+ Set.fromList ["id", "task_id", "event_type", "actor"]
+ `Set.isSubsetOf` Set.fromList eventsCols
Test.@?= True
Set.fromList ["task_id", "attempt", "reason"]
`Set.isSubsetOf` Set.fromList retryCols