commit 01de0612b51b64077d10d05268e89f5e2b3b8001
Author: Ben Sima <ben@bensima.com>
Date: Tue Nov 25 23:22:13 2025
jr: implement Gerrit-style conflict handling
- Add RetryContext to track failed attempts (merge conflicts,
rejections) - jr review checks for clean cherry-pick before showing
diff - If conflict detected, kicks back to coder with context -
Worker prompt includes retry context (attempt count, conflict files,
reason) - After 3 failed attempts, marks task for human intervention
Task-Id: t-1o2g8gudqlx
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs
index 89800e41..1cdeb6d4 100644
--- a/Omni/Agent/Worker.hs
+++ b/Omni/Agent/Worker.hs
@@ -84,7 +84,10 @@ processTask worker task = do
runAmp :: FilePath -> TaskCore.Task -> IO (Exit.ExitCode, Text)
runAmp repo task = do
- let prompt =
+ -- Check for retry context
+ maybeRetry <- TaskCore.getRetryContext (TaskCore.taskId task)
+
+ let basePrompt =
"You are a Worker Agent.\n"
<> "Your goal is to implement the following task:\n\n"
<> formatTask task
@@ -103,6 +106,35 @@ runAmp repo task = do
<> fromMaybe "root" (TaskCore.taskNamespace task)
<> "'.\n"
+ -- Add retry context if present
+ let retryPrompt = case maybeRetry of
+ Nothing -> ""
+ Just ctx ->
+ "\n\n## RETRY CONTEXT (IMPORTANT)\n\n"
+ <> "This task was previously attempted but failed. Attempt: "
+ <> tshow (TaskCore.retryAttempt ctx)
+ <> "/3\n"
+ <> "Reason: "
+ <> TaskCore.retryReason ctx
+ <> "\n\n"
+ <> ( if null (TaskCore.retryConflictFiles ctx)
+ then ""
+ else
+ "Conflicting files from previous attempt:\n"
+ <> Text.unlines (map (" - " <>) (TaskCore.retryConflictFiles ctx))
+ <> "\n"
+ )
+ <> "Original commit: "
+ <> TaskCore.retryOriginalCommit ctx
+ <> "\n\n"
+ <> "INSTRUCTIONS FOR RETRY:\n"
+ <> "- The codebase has changed since your last attempt\n"
+ <> "- Re-implement this task on top of the CURRENT codebase\n"
+ <> "- If there were merge conflicts, the conflicting files may have been modified by others\n"
+ <> "- Review the current state of those files before making changes\n"
+
+ let prompt = basePrompt <> retryPrompt
+
let logFile = repo </> "_/llm/amp.log"
-- Read AGENTS.md
diff --git a/Omni/Jr.hs b/Omni/Jr.hs
index bae55883..0cf22f66 100644
--- a/Omni/Jr.hs
+++ b/Omni/Jr.hs
@@ -4,6 +4,7 @@
-- : out jr
-- : dep sqlite-simple
+-- : dep sqids
module Omni.Jr where
import Alpha
@@ -143,26 +144,112 @@ reviewTask tid = do
(x : _) -> x
[] -> ""
- putText "\n=== Diff for this task ===\n"
- _ <- Process.rawSystem "git" ["show", commitSha]
-
- putText "\n[a]ccept / [r]eject / [s]kip? "
- IO.hFlush IO.stdout
- choice <- getLine
-
- case Text.toLower choice of
- c
- | "a" `Text.isPrefixOf` c -> do
- TaskCore.updateTaskStatus tid TaskCore.Done []
- putText ("Task " <> tid <> " marked as Done.")
- | "r" `Text.isPrefixOf` c -> do
- putText "Enter rejection reason: "
- IO.hFlush IO.stdout
- reason <- getLine
+ -- Check for merge conflicts before showing diff
+ conflictResult <- checkMergeConflict commitSha
+ case conflictResult of
+ Just conflictFiles -> do
+ putText "\n=== MERGE CONFLICT DETECTED ==="
+ putText "This commit cannot be cleanly applied to live."
+ putText "Conflicting files:"
+ traverse_ (\f -> putText (" - " <> f)) conflictFiles
+ putText ""
+ putText "Kicking back to coder with context..."
+
+ -- Get current retry count
+ maybeCtx <- TaskCore.getRetryContext tid
+ let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx
+
+ if attempt > 3
+ then do
+ putText "\nTask has failed 3 times. Marking as NeedsHuman."
+ -- For now, just mark as Open with a note (no NeedsHuman status yet)
+ TaskCore.updateTaskStatus tid TaskCore.Open []
+ putText ("Task " <> tid <> " needs human intervention (3 failed attempts).")
+ else do
+ -- Save retry context
+ TaskCore.setRetryContext
+ TaskCore.RetryContext
+ { TaskCore.retryTaskId = tid,
+ TaskCore.retryOriginalCommit = Text.pack commitSha,
+ TaskCore.retryConflictFiles = conflictFiles,
+ TaskCore.retryAttempt = attempt,
+ TaskCore.retryReason = "merge_conflict"
+ }
TaskCore.updateTaskStatus tid TaskCore.Open []
- putText ("Task " <> tid <> " reopened.")
- putText ("Reason: " <> reason)
- | otherwise -> putText "Skipped; no status change."
+ putText ("Task " <> tid <> " returned to queue (attempt " <> tshow attempt <> "/3).")
+ Nothing -> do
+ -- No conflict, proceed with normal review
+ putText "\n=== Diff for this task ===\n"
+ _ <- Process.rawSystem "git" ["show", commitSha]
+
+ putText "\n[a]ccept / [r]eject / [s]kip? "
+ IO.hFlush IO.stdout
+ choice <- getLine
+
+ case Text.toLower choice of
+ c
+ | "a" `Text.isPrefixOf` c -> do
+ TaskCore.clearRetryContext tid
+ TaskCore.updateTaskStatus tid TaskCore.Done []
+ putText ("Task " <> tid <> " marked as Done.")
+ | "r" `Text.isPrefixOf` c -> do
+ putText "Enter rejection reason: "
+ IO.hFlush IO.stdout
+ reason <- getLine
+ -- Save rejection as retry context
+ maybeCtx <- TaskCore.getRetryContext tid
+ let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
+ TaskCore.setRetryContext
+ TaskCore.RetryContext
+ { TaskCore.retryTaskId = tid,
+ TaskCore.retryOriginalCommit = Text.pack commitSha,
+ TaskCore.retryConflictFiles = [],
+ TaskCore.retryAttempt = attempt,
+ TaskCore.retryReason = "rejected: " <> reason
+ }
+ TaskCore.updateTaskStatus tid TaskCore.Open []
+ putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).")
+ | otherwise -> putText "Skipped; no status change."
+
+-- | Check if a commit can be cleanly cherry-picked onto live
+-- Returns Nothing if clean, Just [conflicting files] if conflict
+checkMergeConflict :: String -> IO (Maybe [Text])
+checkMergeConflict commitSha = do
+ -- Save current state
+ (_, _, _) <- Process.readProcessWithExitCode "git" ["branch", "--show-current"] ""
+ (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""
+
+ -- Try cherry-pick
+ (cpCode, _, cpErr) <-
+ Process.readProcessWithExitCode
+ "git"
+ ["cherry-pick", "--no-commit", commitSha]
+ ""
+
+ -- Always abort/reset regardless of result
+ _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
+ _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""
+
+ case cpCode of
+ Exit.ExitSuccess -> pure Nothing
+ Exit.ExitFailure _ -> do
+ -- Parse conflict files from error message
+ let errLines = Text.lines (Text.pack cpErr)
+ conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
+ -- Extract file names (rough parsing)
+ files = mapMaybe extractConflictFile conflictLines
+ pure (Just (if null files then ["(unknown files)"] else files))
+
+extractConflictFile :: Text -> Maybe Text
+extractConflictFile line =
+ -- CONFLICT (content): Merge conflict in path/to/file.hs
+ case Text.breakOn "Merge conflict in " line of
+ (_, rest)
+ | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
+ _ -> case Text.breakOn "in " line of
+ (_, rest)
+ | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
+ _ -> Nothing
test :: Test.Tree
test =
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 5b1551c4..b28b402a 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
+-- : dep sqids
module Omni.Task.Core where
import Alpha
@@ -70,6 +71,16 @@ data TaskProgress = TaskProgress
}
deriving (Show, Eq, Generic)
+-- Retry context for tasks that failed due to merge conflicts
+data RetryContext = RetryContext
+ { retryTaskId :: Text,
+ retryOriginalCommit :: Text,
+ retryConflictFiles :: [Text],
+ retryAttempt :: Int,
+ retryReason :: Text -- "merge_conflict" | "ci_failure" | "rejected"
+ }
+ deriving (Show, Eq, Generic)
+
instance ToJSON TaskType
instance FromJSON TaskType
@@ -98,6 +109,10 @@ instance ToJSON TaskProgress
instance FromJSON TaskProgress
+instance ToJSON RetryContext
+
+instance FromJSON RetryContext
+
-- SQLite Instances
instance SQL.FromField TaskType where
@@ -251,6 +266,15 @@ initTaskDb = do
SQL.execute_
conn
"INSERT OR IGNORE INTO id_counter (id, counter) VALUES (1, 0)"
+ SQL.execute_
+ conn
+ "CREATE TABLE IF NOT EXISTS retry_context (\
+ \ task_id TEXT PRIMARY KEY, \
+ \ original_commit TEXT NOT NULL, \
+ \ conflict_files TEXT NOT NULL, \
+ \ attempt INTEGER NOT NULL DEFAULT 1, \
+ \ reason TEXT NOT NULL \
+ \)"
-- Sqids configuration: lowercase alphabet only, minimum length 8
sqidsOptions :: Sqids.SqidsOptions
@@ -851,3 +875,56 @@ importTasks filePath = do
if T.null line
then Nothing
else decode (BLC.pack <| T.unpack line)
+
+-- Retry context management
+
+-- | Get retry context for a task (if any)
+getRetryContext :: Text -> IO (Maybe RetryContext)
+getRetryContext tid =
+ withDb <| \conn -> do
+ rows <-
+ SQL.query
+ conn
+ "SELECT task_id, original_commit, conflict_files, attempt, reason FROM retry_context WHERE task_id = ?"
+ (SQL.Only tid) ::
+ IO [(Text, Text, Text, Int, Text)]
+ case rows of
+ [] -> pure Nothing
+ ((taskId, commit, filesJson, attempt, reason) : _) ->
+ let files = fromMaybe [] (decode (BLC.pack <| T.unpack filesJson))
+ in pure
+ <| Just
+ RetryContext
+ { retryTaskId = taskId,
+ retryOriginalCommit = commit,
+ retryConflictFiles = files,
+ retryAttempt = attempt,
+ retryReason = reason
+ }
+
+-- | Set retry context for a task (upsert)
+setRetryContext :: RetryContext -> IO ()
+setRetryContext ctx =
+ withDb <| \conn -> do
+ 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)
+
+-- | Clear retry context for a task (on successful merge)
+clearRetryContext :: Text -> IO ()
+clearRetryContext tid =
+ withDb <| \conn ->
+ SQL.execute conn "DELETE FROM retry_context WHERE task_id = ?" (SQL.Only tid)
+
+-- | Increment retry attempt and return new count
+incrementRetryAttempt :: Text -> IO Int
+incrementRetryAttempt tid = do
+ maybeCtx <- getRetryContext tid
+ case maybeCtx of
+ Nothing -> pure 1
+ Just ctx -> do
+ let newAttempt = retryAttempt ctx + 1
+ setRetryContext ctx {retryAttempt = newAttempt}
+ pure newAttempt