diff options
| -rw-r--r-- | Omni/Agent/Worker.hs | 38 | ||||
| -rw-r--r-- | Omni/Jr.hs | 180 |
2 files changed, 130 insertions, 88 deletions
diff --git a/Omni/Agent/Worker.hs b/Omni/Agent/Worker.hs index 3190bc7..d4809d2 100644 --- a/Omni/Agent/Worker.hs +++ b/Omni/Agent/Worker.hs @@ -18,7 +18,10 @@ import qualified System.Process as Process start :: Core.Worker -> Maybe Text -> IO () start worker maybeTaskId = do AgentLog.init (Core.workerName worker) - AgentLog.log ("Worker starting for " <> Core.workerName worker) + AgentLog.log ("[worker] Starting for " <> Core.workerName worker) + case maybeTaskId of + Just tid -> AgentLog.log ("[worker] Target task: " <> tid) + Nothing -> AgentLog.log "[worker] No specific task, will pick from ready queue" runOnce worker maybeTaskId runOnce :: Core.Worker -> Maybe Text -> IO () @@ -38,10 +41,10 @@ runOnce worker maybeTaskId = do case maybeTaskId of Just tid -> do AgentLog.updateActivity ("Task " <> tid <> " not found.") - AgentLog.log ("Task " <> tid <> " not found.") + AgentLog.log ("[worker] Task " <> tid <> " not found.") Nothing -> do AgentLog.updateActivity "No work found." - AgentLog.log "No ready tasks found." + AgentLog.log "[worker] No ready tasks found." Just task -> do processTask worker task @@ -51,32 +54,30 @@ processTask worker task = do let tid = TaskCore.taskId task AgentLog.update (\s -> s {AgentLog.statusTask = Just tid}) - AgentLog.updateActivity ("Claiming task " <> tid) + AgentLog.log ("[worker] Claiming task " <> tid) -- Claim task TaskCore.updateTaskStatus tid TaskCore.InProgress [] + AgentLog.log "[worker] Status -> InProgress" -- Run Amp - AgentLog.updateActivity "Running Amp agent..." + AgentLog.log "[worker] Starting amp..." (exitCode, output) <- runAmp repo task + AgentLog.log ("[worker] Amp exited with: " <> tshow exitCode) case exitCode of Exit.ExitSuccess -> do - AgentLog.log "Agent finished successfully" - - -- Run formatting and linting before commit - AgentLog.updateActivity "Running formatters..." + AgentLog.log "[worker] Running formatters..." _ <- runFormatters repo -- Try to commit (this runs git hooks which may fail) let commitMsg = formatCommitMessage task output - AgentLog.updateActivity "Committing..." + AgentLog.log "[worker] Attempting commit..." commitResult <- tryCommit repo commitMsg case commitResult of Left commitErr -> do - AgentLog.log ("Commit failed: " <> commitErr) - AgentLog.updateActivity "Commit failed, will retry" + AgentLog.log ("[worker] Commit failed: " <> commitErr) -- Save failure context and reopen task for retry maybeCtx <- TaskCore.getRetryContext tid @@ -84,7 +85,7 @@ processTask worker task = do if attempt > 3 then do - AgentLog.log "Task failed 3 times, needs human intervention" + AgentLog.log "[worker] Task failed 3 times, needs human intervention" TaskCore.updateTaskStatus tid TaskCore.Open [] else do TaskCore.setRetryContext @@ -96,17 +97,16 @@ processTask worker task = do TaskCore.retryReason = "commit_failed: " <> commitErr } TaskCore.updateTaskStatus tid TaskCore.Open [] - AgentLog.log ("Task reopened (attempt " <> tshow attempt <> "/3)") + AgentLog.log ("[worker] Task reopened (attempt " <> tshow attempt <> "/3)") Right () -> do -- Only set to Review after successful commit TaskCore.updateTaskStatus tid TaskCore.Review [] - AgentLog.updateActivity "Task completed" - AgentLog.log ("[✓] Task " <> tid <> " completed") + AgentLog.log ("[worker] ✓ Task " <> tid <> " -> Review") AgentLog.update (\s -> s {AgentLog.statusTask = Nothing}) Exit.ExitFailure code -> do - AgentLog.log ("Agent failed with code " <> tshow code) - AgentLog.updateActivity "Agent failed, retrying..." - threadDelay (10 * 1000000) -- Sleep 10s + AgentLog.log ("[worker] Amp failed with code " <> tshow code) + -- Don't set back to Open here - leave in InProgress for debugging + AgentLog.log "[worker] Task left in InProgress (amp failure)" -- | Run lint --fix to format and fix lint issues runFormatters :: FilePath -> IO (Either Text ()) @@ -119,47 +119,116 @@ move args -- | Run the autonomous loop: work -> review -> repeat runLoop :: Int -> IO () runLoop delaySec = do - putText "Starting autonomous jr loop..." - putText ("Delay between iterations: " <> tshow delaySec <> "s") + putText "[loop] Starting autonomous jr loop..." + putText ("[loop] Delay between iterations: " <> tshow delaySec <> "s") go where go = do - -- Check for ready work - readyTasks <- TaskCore.getReadyTasks - case readyTasks of - [] -> do - putText "\nNo ready tasks. Checking for tasks to review..." - reviewPending - (task : _) -> do - putText ("\n=== Working on: " <> TaskCore.taskId task <> " ===") - -- Run worker - absPath <- Directory.getCurrentDirectory - let name = Text.pack (takeFileName absPath) - let worker = - AgentCore.Worker - { AgentCore.workerName = name, - AgentCore.workerPid = Nothing, - AgentCore.workerStatus = AgentCore.Idle, - AgentCore.workerPath = "." - } - AgentWorker.start worker (Just (TaskCore.taskId task)) - -- After work, check for review - reviewPending - - -- Delay and loop - putText ("\nSleeping " <> tshow delaySec <> "s...") - threadDelay (delaySec * 1000000) - go - + -- First check for tasks to review (prioritize finishing work) + reviewResult <- reviewPending + if reviewResult + then do + -- Reviewed something, continue loop immediately + threadDelay (delaySec * 1000000) + go + else do + -- No reviews, check for ready work + readyTasks <- TaskCore.getReadyTasks + case readyTasks of + [] -> do + putText "[loop] No ready tasks, no pending reviews." + (task : _) -> do + putText "" + putText ("[loop] === Working on: " <> TaskCore.taskId task <> " ===") + -- Run worker (this blocks until amp completes) + absPath <- Directory.getCurrentDirectory + let name = Text.pack (takeFileName absPath) + let worker = + AgentCore.Worker + { AgentCore.workerName = name, + AgentCore.workerPid = Nothing, + AgentCore.workerStatus = AgentCore.Idle, + AgentCore.workerPath = "." + } + putText "[loop] Starting worker..." + AgentWorker.start worker (Just (TaskCore.taskId task)) + putText "[loop] Worker finished." + + -- Delay and loop + putText ("[loop] Sleeping " <> tshow delaySec <> "s...") + threadDelay (delaySec * 1000000) + go + + -- Returns True if a task was reviewed, False otherwise + reviewPending :: IO Bool reviewPending = do tasks <- TaskCore.loadTasks let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks case reviewTasks of - [] -> putText "No tasks pending review." + [] -> pure False (t : _) -> do - putText ("\n=== Auto-reviewing: " <> TaskCore.taskId t <> " ===") - reviewTask (TaskCore.taskId t) True + putText "" + putText ("[loop] === Reviewing: " <> TaskCore.taskId t <> " ===") + tryAutoReview (TaskCore.taskId t) + pure True + -- Auto-review that doesn't exit on missing commit + tryAutoReview :: Text -> IO () + tryAutoReview tid = do + tasks <- TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> do + putText ("[review] Task " <> tid <> " not found.") + Just task -> do + let grepArg = "--grep=" <> Text.unpack tid + (code, shaOut, _) <- + Process.readProcessWithExitCode + "git" + ["log", "--pretty=format:%H", "-n", "1", grepArg] + "" + + if code /= Exit.ExitSuccess || null shaOut + then do + putText "[review] No commit found for this task yet." + putText "[review] Worker may still be running or commit failed. Skipping." + else do + let commitSha = case List.lines shaOut of + (x : _) -> x + [] -> "" + + -- Check for merge conflicts + conflictResult <- checkMergeConflict commitSha + case conflictResult of + Just conflictFiles -> do + putText "[review] MERGE CONFLICT DETECTED" + traverse_ (\f -> putText (" - " <> f)) conflictFiles + handleConflict tid conflictFiles commitSha + Nothing -> do + autoReview tid task commitSha + +-- | Handle merge conflict during review +handleConflict :: Text -> [Text] -> String -> IO () +handleConflict tid conflictFiles commitSha = do + maybeCtx <- TaskCore.getRetryContext tid + let attempt = maybe 1 (\c -> TaskCore.retryAttempt c + 1) maybeCtx + + if attempt > 3 + then do + putText "[review] Task has failed 3 times. Needs human intervention." + TaskCore.updateTaskStatus tid TaskCore.Open [] + else do + 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 ("[review] Task " <> tid <> " returned to queue (attempt " <> tshow attempt <> "/3).") + +-- | Interactive review command (jr review <task-id>) reviewTask :: Text -> Bool -> IO () reviewTask tid autoMode = do tasks <- TaskCore.loadTasks @@ -191,34 +260,8 @@ reviewTask tid autoMode = do 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 <> " returned to queue (attempt " <> tshow attempt <> "/3).") + handleConflict tid conflictFiles commitSha Nothing -> do if autoMode then autoReview tid task commitSha @@ -227,14 +270,14 @@ reviewTask tid autoMode = do -- | Auto-review: run tests on namespace, accept if pass, reject if fail autoReview :: Text -> TaskCore.Task -> String -> IO () autoReview tid task commitSha = do - putText "Running automated review..." + putText "[review] Running automated review..." + putText ("[review] Commit: " <> Text.pack (take 8 commitSha)) -- Determine what to test based on namespace - -- Keep .hs suffix since bild expects it let namespace = fromMaybe "." (TaskCore.taskNamespace task) let testTarget = Text.unpack namespace - putText ("Testing: " <> Text.pack testTarget) + putText ("[review] Testing: " <> Text.pack testTarget) -- Run bild --test on the namespace (testCode, testOut, testErr) <- @@ -245,12 +288,12 @@ autoReview tid task commitSha = do case testCode of Exit.ExitSuccess -> do - putText "✓ Tests passed. Accepting task." + putText "[review] ✓ Tests passed." TaskCore.clearRetryContext tid TaskCore.updateTaskStatus tid TaskCore.Done [] - putText ("Task " <> tid <> " marked as Done.") - Exit.ExitFailure _ -> do - putText "✗ Tests failed. Rejecting task." + putText ("[review] Task " <> tid <> " -> Done") + Exit.ExitFailure code -> do + putText ("[review] ✗ Tests failed (exit " <> tshow code <> ")") let reason = "Test failure:\n" <> Text.pack testOut <> Text.pack testErr maybeCtx <- TaskCore.getRetryContext tid @@ -258,9 +301,8 @@ autoReview tid task commitSha = do if attempt > 3 then do - putText "\nTask has failed 3 times. Marking as NeedsHuman." + putText "[review] Task has failed 3 times. Needs human intervention." TaskCore.updateTaskStatus tid TaskCore.Open [] - putText ("Task " <> tid <> " needs human intervention (3 failed attempts).") else do TaskCore.setRetryContext TaskCore.RetryContext @@ -271,7 +313,7 @@ autoReview tid task commitSha = do TaskCore.retryReason = reason } TaskCore.updateTaskStatus tid TaskCore.Open [] - putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).") + putText ("[review] Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).") -- | Interactive review with user prompts interactiveReview :: Text -> String -> IO () |