summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rw-r--r--Omni/Agent/Worker.hs4
-rwxr-xr-xOmni/Jr.hs10
-rw-r--r--Omni/Jr/Web.hs51
-rw-r--r--Omni/Task/Core.hs48
4 files changed, 89 insertions, 24 deletions
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index eef31f4..3edfbca 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -131,7 +131,8 @@ processTask worker task = do
TaskCore.retryOriginalCommit = "",
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = "commit_failed: " <> commitErr
+ TaskCore.retryReason = "commit_failed: " <> commitErr,
+ TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.logActivity tid TaskCore.Retrying (Just (toMetadata [("attempt", tshow attempt)]))
TaskCore.updateTaskStatus tid TaskCore.Open []
@@ -245,6 +246,7 @@ runAmp repo task = do
<> "Original commit: "
<> TaskCore.retryOriginalCommit ctx
<> "\n\n"
+ <> maybe "" (\notes -> "## HUMAN NOTES/GUIDANCE\n\n" <> notes <> "\n\n") (TaskCore.retryNotes ctx)
<> "INSTRUCTIONS FOR RETRY:\n"
<> "- The codebase has changed since your last attempt\n"
<> "- Re-implement this task on top of the CURRENT codebase\n"
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
index 2de4975..0746424 100755
--- a/Omni/Jr.hs
+++ b/Omni/Jr.hs
@@ -221,13 +221,15 @@ handleConflict tid conflictFiles commitSha = do
TaskCore.updateTaskStatus tid TaskCore.Open []
else do
conflictDetails <- gatherConflictContext commitSha conflictFiles
+ maybeExistingCtx <- TaskCore.getRetryContext tid
TaskCore.setRetryContext
TaskCore.RetryContext
{ TaskCore.retryTaskId = tid,
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = conflictFiles,
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = conflictDetails
+ TaskCore.retryReason = conflictDetails,
+ TaskCore.retryNotes = maybeExistingCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("[review] Task " <> tid <> " returned to queue (attempt " <> tshow attempt <> "/3).")
@@ -401,7 +403,8 @@ autoReview tid task commitSha = do
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = reason
+ TaskCore.retryReason = reason,
+ TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("[review] Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
@@ -435,7 +438,8 @@ interactiveReview tid commitSha = do
TaskCore.retryOriginalCommit = Text.pack commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = "rejected: " <> reason
+ TaskCore.retryReason = "rejected: " <> reason,
+ TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 00e0c88..52306c2 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -61,6 +61,7 @@ type API =
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
:<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
:<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect
+ :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
:<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
:<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
:<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
@@ -153,6 +154,13 @@ instance FromForm DescriptionForm where
desc <- parseUnique "description" form
Right (DescriptionForm desc)
+newtype NotesForm = NotesForm Text
+
+instance FromForm NotesForm where
+ fromForm form = do
+ notes <- parseUnique "notes" form
+ Right (NotesForm notes)
+
pageHead :: (Monad m) => Text -> Lucid.HtmlT m ()
pageHead title =
Lucid.head_ <| do
@@ -429,7 +437,7 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.div_ [Lucid.class_ "container"] <| do
Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
- renderRetryContextBanner maybeRetry
+ renderRetryContextBanner (TaskCore.taskId task) maybeRetry
Lucid.div_ [Lucid.class_ "task-detail"] <| do
Lucid.div_ [Lucid.class_ "detail-row"] <| do
@@ -681,9 +689,9 @@ instance Lucid.ToHtml TaskDetailPage where
let dollars = fromIntegral cents / 100.0 :: Double
in "$" <> Text.pack (showFFloat (Just 2) dollars "")
-renderRetryContextBanner :: (Monad m) => Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
-renderRetryContextBanner Nothing = pure ()
-renderRetryContextBanner (Just ctx) =
+renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
+renderRetryContextBanner _ Nothing = pure ()
+renderRetryContextBanner tid (Just ctx) =
Lucid.div_ [Lucid.class_ bannerClass] <| do
Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do
Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon
@@ -709,10 +717,32 @@ renderRetryContextBanner (Just ctx) =
Lucid.ul_ [Lucid.class_ "retry-conflict-list"]
<| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts
- when maxRetriesExceeded
- <| Lucid.div_
+ when maxRetriesExceeded <| do
+ Lucid.div_
[Lucid.class_ "retry-warning-message"]
"This task has exceeded the maximum number of retries. A human must review the failure and either fix the issue manually or reset the retry count."
+
+ Lucid.div_ [Lucid.class_ "retry-notes-section"] <| do
+ Lucid.h4_ "Human Notes/Guidance"
+ Lucid.p_ [Lucid.class_ "notes-help"] "Add notes to guide the worker on the next retry attempt:"
+ Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/notes")] <| do
+ Lucid.textarea_
+ [ Lucid.name_ "notes",
+ Lucid.class_ "notes-textarea",
+ Lucid.rows_ "6",
+ Lucid.placeholder_ "Provide guidance for the worker: what to fix, which approach to use, or what to avoid..."
+ ]
+ (Lucid.toHtml (fromMaybe "" (TaskCore.retryNotes ctx)))
+ Lucid.div_ [Lucid.class_ "form-actions"] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Notes"
+
+ case TaskCore.retryNotes ctx of
+ Nothing -> pure ()
+ Just notes ->
+ unless maxRetriesExceeded <| do
+ Lucid.div_ [Lucid.class_ "retry-notes-display"] <| do
+ Lucid.h4_ "Human Notes"
+ Lucid.div_ [Lucid.class_ "notes-content"] (Lucid.toHtml notes)
where
attempt = TaskCore.retryAttempt ctx
maxRetriesExceeded = attempt >= 3
@@ -1154,6 +1184,7 @@ server =
:<|> taskDetailHandler
:<|> taskStatusHandler
:<|> taskDescriptionHandler
+ :<|> taskNotesHandler
:<|> taskReviewHandler
:<|> taskDiffHandler
:<|> taskAcceptHandler
@@ -1261,6 +1292,11 @@ server =
_ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descMaybe})
pure <| addHeader ("/tasks/" <> tid) NoContent
+ taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
+ taskNotesHandler tid (NotesForm notes) = do
+ liftIO <| TaskCore.updateRetryNotes tid notes
+ pure <| addHeader ("/tasks/" <> tid) NoContent
+
taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
taskReviewHandler tid = do
tasks <- liftIO TaskCore.loadTasks
@@ -1298,7 +1334,8 @@ server =
TaskCore.retryOriginalCommit = commitSha,
TaskCore.retryConflictFiles = [],
TaskCore.retryAttempt = attempt,
- TaskCore.retryReason = reason
+ TaskCore.retryReason = reason,
+ TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
}
TaskCore.updateTaskStatus tid TaskCore.Open []
pure <| addHeader ("/tasks/" <> tid) NoContent
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 5af4ce4..4eac9b5 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -78,7 +78,8 @@ data RetryContext = RetryContext
retryOriginalCommit :: Text,
retryConflictFiles :: [Text],
retryAttempt :: Int,
- retryReason :: Text -- "merge_conflict" | "ci_failure" | "rejected"
+ retryReason :: Text, -- "merge_conflict" | "ci_failure" | "rejected"
+ retryNotes :: Maybe Text -- Human notes/guidance for intervention
}
deriving (Show, Eq, Generic)
@@ -422,7 +423,8 @@ retryContextColumns =
("original_commit", "TEXT"),
("conflict_files", "TEXT"),
("attempt", "INTEGER"),
- ("reason", "TEXT")
+ ("reason", "TEXT"),
+ ("notes", "TEXT")
]
-- | Migrate a table by adding any missing columns
@@ -1047,21 +1049,22 @@ getRetryContext tid =
rows <-
SQL.query
conn
- "SELECT task_id, original_commit, conflict_files, attempt, reason FROM retry_context WHERE task_id = ?"
+ "SELECT task_id, original_commit, conflict_files, attempt, reason, notes FROM retry_context WHERE task_id = ?"
(SQL.Only tid) ::
- IO [(Text, Text, Text, Int, Text)]
+ IO [(Text, Text, Text, Int, Text, Maybe Text)]
case rows of
[] -> pure Nothing
- ((taskId, commit, filesJson, attempt, reason) : _) ->
+ ((taskId', commit, filesJson, attempt, reason, notes) : _) ->
let files = fromMaybe [] (decode (BLC.pack <| T.unpack filesJson))
in pure
<| Just
RetryContext
- { retryTaskId = taskId,
+ { retryTaskId = taskId',
retryOriginalCommit = commit,
retryConflictFiles = files,
retryAttempt = attempt,
- retryReason = reason
+ retryReason = reason,
+ retryNotes = notes
}
-- | Set retry context for a task (upsert)
@@ -1071,8 +1074,8 @@ setRetryContext ctx =
let filesJson = T.pack <| BLC.unpack <| encode (retryConflictFiles ctx)
SQL.execute
conn
- "INSERT OR REPLACE INTO retry_context (task_id, original_commit, conflict_files, attempt, reason) VALUES (?, ?, ?, ?, ?)"
- (retryTaskId ctx, retryOriginalCommit ctx, filesJson, retryAttempt ctx, retryReason ctx)
+ "INSERT OR REPLACE INTO retry_context (task_id, original_commit, conflict_files, attempt, reason, notes) VALUES (?, ?, ?, ?, ?, ?)"
+ (retryTaskId ctx, retryOriginalCommit ctx, filesJson, retryAttempt ctx, retryReason ctx, retryNotes ctx)
-- | Clear retry context for a task (on successful merge)
clearRetryContext :: Text -> IO ()
@@ -1173,15 +1176,34 @@ getAllRetryContexts =
rows <-
SQL.query_
conn
- "SELECT task_id, original_commit, conflict_files, attempt, reason FROM retry_context" ::
- IO [(Text, Text, Text, Int, Text)]
+ "SELECT task_id, original_commit, conflict_files, attempt, reason, notes FROM retry_context" ::
+ IO [(Text, Text, Text, Int, Text, Maybe Text)]
pure
[ RetryContext
{ retryTaskId = tid,
retryOriginalCommit = commit,
retryConflictFiles = fromMaybe [] (decode (BLC.pack (T.unpack filesJson))),
retryAttempt = attempt,
- retryReason = reason
+ retryReason = reason,
+ retryNotes = notes
}
- | (tid, commit, filesJson, attempt, reason) <- rows
+ | (tid, commit, filesJson, attempt, reason, notes) <- rows
]
+
+-- | Update just the notes field for a retry context
+updateRetryNotes :: Text -> Text -> IO ()
+updateRetryNotes tid notes = do
+ maybeCtx <- getRetryContext tid
+ case maybeCtx of
+ Nothing ->
+ setRetryContext
+ RetryContext
+ { retryTaskId = tid,
+ retryOriginalCommit = "",
+ retryConflictFiles = [],
+ retryAttempt = 0,
+ retryReason = "",
+ retryNotes = Just notes
+ }
+ Just ctx ->
+ setRetryContext ctx {retryNotes = Just notes}
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 21:25:48 +0000