diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Jr.hs | 191 |
1 files changed, 153 insertions, 38 deletions
@@ -51,7 +51,8 @@ Usage: jr task [<args>...] jr work [<task-id>] jr web [--port=PORT] - jr review <task-id> + jr review [<task-id>] [--auto] + jr loop [--delay=SECONDS] jr merge-driver <ours> <theirs> jr test jr (-h | --help) @@ -61,11 +62,14 @@ Commands: work Start a worker agent on a task web Start the web UI server review Review a completed task (show diff, accept/reject) + loop Run autonomous work+review loop merge-driver Internal git merge driver Options: - -h --help Show this help - --port=PORT Port for web server [default: 8080] + -h --help Show this help + --port=PORT Port for web server [default: 8080] + --auto Auto-review: accept if tests pass, reject if they fail + --delay=SECONDS Delay between loop iterations [default: 5] |] move :: Cli.Arguments -> IO () @@ -98,8 +102,21 @@ move args AgentWorker.start worker taskId | args `Cli.has` Cli.command "review" = do - tidStr <- getArgOrExit args (Cli.argument "task-id") - reviewTask (Text.pack tidStr) + let autoMode = args `Cli.has` Cli.longOption "auto" + case Cli.getArg args (Cli.argument "task-id") of + Just tidStr -> reviewTask (Text.pack tidStr) autoMode + Nothing -> do + -- Find tasks in Review status + tasks <- TaskCore.loadTasks + let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks + case reviewTasks of + [] -> putText "No tasks in Review status." + (t : _) -> reviewTask (TaskCore.taskId t) autoMode + | args `Cli.has` Cli.command "loop" = do + let delay = case Cli.getArg args (Cli.longOption "delay") of + Just d -> fromMaybe 5 (readMaybe d) + Nothing -> 5 + runLoop delay | args `Cli.has` Cli.command "merge-driver" = mergeDriver args | otherwise = putText (str <| Docopt.usage help) @@ -131,15 +148,59 @@ getArgOrExit args opt = putText <| "Error: Missing required argument " <> Text.pack (show opt) Exit.exitFailure -reviewTask :: Text -> IO () -reviewTask tid = do +-- | 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") + 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 + + reviewPending = do + tasks <- TaskCore.loadTasks + let reviewTasks = filter (\t -> TaskCore.taskStatus t == TaskCore.Review) tasks + case reviewTasks of + [] -> putText "No tasks pending review." + (t : _) -> do + putText ("\n=== Auto-reviewing: " <> TaskCore.taskId t <> " ===") + reviewTask (TaskCore.taskId t) True + +reviewTask :: Text -> Bool -> IO () +reviewTask tid autoMode = do tasks <- TaskCore.loadTasks case TaskCore.findTask tid tasks of Nothing -> do putText ("Task " <> tid <> " not found.") Exit.exitFailure Just task -> do - TaskCore.showTaskDetailed task + unless autoMode <| TaskCore.showTaskDetailed task let grepArg = "--grep=" <> Text.unpack tid (code, shaOut, _) <- @@ -191,38 +252,92 @@ reviewTask tid = do TaskCore.updateTaskStatus tid TaskCore.Open [] 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] + if autoMode + then autoReview tid task commitSha + else interactiveReview tid commitSha + +-- | 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..." + + -- Determine what to test based on namespace + let namespace = fromMaybe "." (TaskCore.taskNamespace task) + let testTarget = Text.unpack (Text.replace ".hs" "" namespace) + + putText ("Testing: " <> Text.pack testTarget) + + -- Run bild --test on the namespace + (testCode, testOut, testErr) <- + Process.readProcessWithExitCode + "bild" + ["--test", testTarget] + "" - putText "\n[a]ccept / [r]eject / [s]kip? " + case testCode of + Exit.ExitSuccess -> do + putText "✓ Tests passed. Accepting task." + TaskCore.clearRetryContext tid + TaskCore.updateTaskStatus tid TaskCore.Done [] + putText ("Task " <> tid <> " marked as Done.") + Exit.ExitFailure _ -> do + putText "✗ Tests failed. Rejecting task." + let reason = "Test failure:\n" <> Text.pack testOut <> Text.pack testErr + + maybeCtx <- TaskCore.getRetryContext tid + let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx + + if attempt > 3 + then do + putText "\nTask has failed 3 times. Marking as NeedsHuman." + TaskCore.updateTaskStatus tid TaskCore.Open [] + putText ("Task " <> tid <> " needs human intervention (3 failed attempts).") + else do + TaskCore.setRetryContext + TaskCore.RetryContext + { TaskCore.retryTaskId = tid, + TaskCore.retryOriginalCommit = Text.pack commitSha, + TaskCore.retryConflictFiles = [], + TaskCore.retryAttempt = attempt, + TaskCore.retryReason = reason + } + TaskCore.updateTaskStatus tid TaskCore.Open [] + putText ("Task " <> tid <> " reopened (attempt " <> tshow attempt <> "/3).") + +-- | Interactive review with user prompts +interactiveReview :: Text -> String -> IO () +interactiveReview tid commitSha = do + 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 - 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." + 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 |