summaryrefslogtreecommitdiff
path: root/Omni/Task/Core.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bensima.com>2025-11-25 23:22:13 -0500
committerBen Sima <ben@bensima.com>2025-11-25 23:22:13 -0500
commit01de0612b51b64077d10d05268e89f5e2b3b8001 (patch)
treeab47e82acba4dcf5cb64b52cf5dcc5b6661403fe /Omni/Task/Core.hs
parent2e4bfbffba747efcee6c5de25f8a5325b36859c4 (diff)
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
Diffstat (limited to 'Omni/Task/Core.hs')
-rw-r--r--Omni/Task/Core.hs77
1 files changed, 77 insertions, 0 deletions
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 5b1551c..b28b402 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