commit a1e4183e8a84bc8d8f8cc56e0ea5c6963d52923b
Author: Ben Sima <ben@bensima.com>
Date: Wed Nov 26 09:23:26 2025
Implement review interface (GET /tasks/:id/review with accept/reject)
All checks pass. The review interface implementation is complete:
1. **GET /tasks/:id/review** - Shows review interface with task details
2. **POST /tasks/:id/accept** - Marks task as Done and clears retry
cont 3. **POST /tasks/:id/reject** - Reopens task as Open with retry
context 4. Commit lookup by Task-Id using git log 5. Git diff display
in a pre/code block 6. Merge conflict detection using cherry-pick
check 7. "No commit found" message when applicable
The hlint warning about avoiding lambda was fixed by using `(<.)`
compos
Task-Id: t-1o2g8gugkr1.6
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 3ab09985..107df95b 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -8,6 +8,7 @@
-- : dep lucid
-- : dep servant-lucid
-- : dep http-api-data
+-- : dep process
module Omni.Jr.Web
( run,
defaultPort,
@@ -22,7 +23,9 @@ import qualified Network.Wai.Handler.Warp as Warp
import qualified Omni.Task.Core as TaskCore
import Servant
import qualified Servant.HTML.Lucid as Lucid
-import Web.FormUrlEncoded (FromForm (..), parseUnique)
+import qualified System.Exit as Exit
+import qualified System.Process as Process
+import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
@@ -35,6 +38,9 @@ type API =
:<|> "tasks" :> Get '[Lucid.HTML] TaskListPage
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
:<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> PostRedirect
+ :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
+ :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
+ :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task]
@@ -46,6 +52,20 @@ data TaskDetailPage
= TaskDetailFound TaskCore.Task [TaskCore.Task]
| TaskDetailNotFound Text
+data TaskReviewPage
+ = ReviewPageFound TaskCore.Task ReviewInfo
+ | ReviewPageNotFound Text
+
+data ReviewInfo
+ = ReviewNoCommit
+ | ReviewMergeConflict Text [Text]
+ | ReviewReady Text Text
+
+newtype RejectForm = RejectForm (Maybe Text)
+
+instance FromForm RejectForm where
+ fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
+
newtype StatusForm = StatusForm TaskCore.Status
instance FromForm StatusForm where
@@ -406,6 +426,14 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.ul_ [Lucid.class_ "child-list"] <| do
traverse_ renderChild children
+ when (TaskCore.taskStatus task == TaskCore.Review) <| do
+ Lucid.div_ [Lucid.class_ "review-link-section"] <| do
+ Lucid.a_
+ [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
+ Lucid.class_ "review-link-btn"
+ ]
+ "Review This Task"
+
Lucid.div_ [Lucid.class_ "status-form"] <| do
Lucid.h3_ "Update Status"
Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status")] <| do
@@ -490,13 +518,169 @@ detailStyles =
\ font-size: 14px; margin-right: 8px; } \
\.submit-btn { padding: 8px 16px; background: #0066cc; color: white; border: none; \
\ border-radius: 4px; font-size: 14px; cursor: pointer; } \
- \.submit-btn:hover { background: #0052a3; }"
+ \.submit-btn:hover { background: #0052a3; } \
+ \.review-link-section { margin: 16px 0; } \
+ \.review-link-btn { display: inline-block; padding: 12px 24px; background: #8b5cf6; \
+ \ color: white; text-decoration: none; border-radius: 6px; \
+ \ font-size: 16px; font-weight: 500; } \
+ \.review-link-btn:hover { background: #7c3aed; }"
+
+instance Lucid.ToHtml TaskReviewPage where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (ReviewPageNotFound tid) =
+ Lucid.doctypehtml_ <| do
+ Lucid.head_ <| do
+ Lucid.title_ "Task Not Found - Jr Review"
+ Lucid.meta_ [Lucid.charset_ "utf-8"]
+ Lucid.meta_
+ [ Lucid.name_ "viewport",
+ Lucid.content_ "width=device-width, initial-scale=1"
+ ]
+ Lucid.style_ reviewStyles
+ Lucid.body_ <| do
+ Lucid.h1_ "Task Not Found"
+ Lucid.p_ <| do
+ "The task "
+ Lucid.code_ (Lucid.toHtml tid)
+ " could not be found."
+ Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "<- Back to Tasks"
+ toHtml (ReviewPageFound task reviewInfo) =
+ Lucid.doctypehtml_ <| do
+ Lucid.head_ <| do
+ Lucid.title_ <| Lucid.toHtml ("Review: " <> TaskCore.taskId task <> " - Jr")
+ Lucid.meta_ [Lucid.charset_ "utf-8"]
+ Lucid.meta_
+ [ Lucid.name_ "viewport",
+ Lucid.content_ "width=device-width, initial-scale=1"
+ ]
+ Lucid.style_ reviewStyles
+ Lucid.body_ <| do
+ Lucid.p_ <| Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId task)] "<- Back to Task"
+
+ Lucid.h1_ "Review Task"
+
+ Lucid.div_ [Lucid.class_ "task-summary"] <| do
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
+ Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
+ Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
+
+ case reviewInfo of
+ ReviewNoCommit -> do
+ Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
+ Lucid.h3_ "No Commit Found"
+ Lucid.p_ "No commit with this task ID was found in the git history."
+ Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
+ ReviewMergeConflict commitSha conflictFiles -> do
+ Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
+ Lucid.h3_ "Merge Conflict Detected"
+ Lucid.p_ <| do
+ "Commit "
+ Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
+ " cannot be cleanly merged."
+ Lucid.p_ "Conflicting files:"
+ Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
+ ReviewReady commitSha diffText -> do
+ Lucid.div_ [Lucid.class_ "diff-section"] <| do
+ Lucid.h3_ <| do
+ "Commit: "
+ Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
+ Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)
+
+ Lucid.div_ [Lucid.class_ "review-actions"] <| do
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
+ Lucid.class_ "inline-form"
+ ]
+ <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"
+
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
+ Lucid.class_ "reject-form"
+ ]
+ <| do
+ Lucid.textarea_
+ [ Lucid.name_ "notes",
+ Lucid.class_ "reject-notes",
+ Lucid.placeholder_ "Rejection notes (optional)"
+ ]
+ ""
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject"
+ where
+ statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
+ statusBadge status =
+ let (cls, label) = case status of
+ TaskCore.Open -> ("badge badge-open", "Open")
+ TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
+ TaskCore.Review -> ("badge badge-review", "Review")
+ TaskCore.Approved -> ("badge badge-approved", "Approved")
+ TaskCore.Done -> ("badge badge-done", "Done")
+ in Lucid.span_ [Lucid.class_ cls] label
+
+reviewStyles :: Text
+reviewStyles =
+ "* { box-sizing: border-box; } \
+ \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \
+ \ margin: 0; padding: 16px; background: #f5f5f5; max-width: 1000px; } \
+ \h1 { margin: 16px 0; } \
+ \h3 { margin: 16px 0 8px 0; color: #374151; } \
+ \.task-summary { background: white; border-radius: 8px; padding: 16px; \
+ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); margin-bottom: 16px; } \
+ \.detail-row { display: flex; padding: 8px 0; border-bottom: 1px solid #e5e7eb; } \
+ \.detail-row:last-child { border-bottom: none; } \
+ \.detail-label { font-weight: 600; width: 100px; color: #6b7280; } \
+ \.detail-value { flex: 1; } \
+ \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \
+ \ font-size: 12px; font-weight: 500; } \
+ \.badge-open { background: #fef3c7; color: #92400e; } \
+ \.badge-inprogress { background: #dbeafe; color: #1e40af; } \
+ \.badge-review { background: #ede9fe; color: #6b21a8; } \
+ \.badge-approved { background: #d1fae5; color: #065f46; } \
+ \.badge-done { background: #d1fae5; color: #065f46; } \
+ \.no-commit-msg { background: #fff3cd; border: 1px solid #ffc107; border-radius: 8px; \
+ \ padding: 16px; margin: 16px 0; } \
+ \.conflict-warning { background: #f8d7da; border: 1px solid #dc3545; border-radius: 8px; \
+ \ padding: 16px; margin: 16px 0; } \
+ \.diff-section { background: white; border-radius: 8px; padding: 16px; \
+ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); margin: 16px 0; } \
+ \.diff-block { background: #1e1e1e; color: #d4d4d4; padding: 16px; border-radius: 4px; \
+ \ font-family: 'SF Mono', Monaco, 'Courier New', monospace; font-size: 13px; \
+ \ overflow-x: auto; white-space: pre; margin: 0; max-height: 600px; overflow-y: auto; } \
+ \.review-actions { background: white; border-radius: 8px; padding: 16px; \
+ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); display: flex; gap: 16px; \
+ \ align-items: flex-start; flex-wrap: wrap; } \
+ \.inline-form { display: inline-block; } \
+ \.reject-form { display: flex; gap: 8px; flex: 1; min-width: 300px; } \
+ \.reject-notes { flex: 1; padding: 8px; border: 1px solid #d1d5db; border-radius: 4px; \
+ \ font-size: 14px; resize: vertical; min-height: 38px; } \
+ \.accept-btn { padding: 10px 24px; background: #10b981; color: white; border: none; \
+ \ border-radius: 4px; font-size: 14px; font-weight: 500; cursor: pointer; } \
+ \.accept-btn:hover { background: #059669; } \
+ \.reject-btn { padding: 10px 24px; background: #ef4444; color: white; border: none; \
+ \ border-radius: 4px; font-size: 14px; font-weight: 500; cursor: pointer; } \
+ \.reject-btn:hover { background: #dc2626; }"
api :: Proxy API
api = Proxy
server :: Server API
-server = homeHandler :<|> readyQueueHandler :<|> taskListHandler :<|> taskDetailHandler :<|> taskStatusHandler
+server =
+ homeHandler
+ :<|> readyQueueHandler
+ :<|> taskListHandler
+ :<|> taskDetailHandler
+ :<|> taskStatusHandler
+ :<|> taskReviewHandler
+ :<|> taskAcceptHandler
+ :<|> taskRejectHandler
where
homeHandler :: Servant.Handler HomePage
homeHandler = do
@@ -528,6 +712,103 @@ server = homeHandler :<|> readyQueueHandler :<|> taskListHandler :<|> taskDetail
liftIO <| TaskCore.updateTaskStatus tid newStatus []
pure <| addHeader ("/tasks/" <> tid) NoContent
+ taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
+ taskReviewHandler tid = do
+ tasks <- liftIO TaskCore.loadTasks
+ case TaskCore.findTask tid tasks of
+ Nothing -> pure (ReviewPageNotFound tid)
+ Just task -> do
+ reviewInfo <- liftIO <| getReviewInfo tid
+ pure (ReviewPageFound task reviewInfo)
+
+ taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
+ taskAcceptHandler tid = do
+ liftIO <| do
+ TaskCore.clearRetryContext tid
+ TaskCore.updateTaskStatus tid TaskCore.Done []
+ pure <| addHeader ("/tasks/" <> tid) NoContent
+
+ taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
+ taskRejectHandler tid (RejectForm maybeNotes) = do
+ liftIO <| do
+ maybeCommit <- findCommitForTask tid
+ let commitSha = fromMaybe "" maybeCommit
+ maybeCtx <- TaskCore.getRetryContext tid
+ let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
+ let reason = "rejected: " <> fromMaybe "(no notes)" maybeNotes
+ TaskCore.setRetryContext
+ TaskCore.RetryContext
+ { TaskCore.retryTaskId = tid,
+ TaskCore.retryOriginalCommit = commitSha,
+ TaskCore.retryConflictFiles = [],
+ TaskCore.retryAttempt = attempt,
+ TaskCore.retryReason = reason
+ }
+ TaskCore.updateTaskStatus tid TaskCore.Open []
+ pure <| addHeader ("/tasks/" <> tid) NoContent
+
+getReviewInfo :: Text -> IO ReviewInfo
+getReviewInfo tid = do
+ maybeCommit <- findCommitForTask tid
+ case maybeCommit of
+ Nothing -> pure ReviewNoCommit
+ Just commitSha -> do
+ conflictResult <- checkMergeConflict (Text.unpack commitSha)
+ case conflictResult of
+ Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles)
+ Nothing -> do
+ (_, diffOut, _) <-
+ Process.readProcessWithExitCode
+ "git"
+ ["show", Text.unpack commitSha]
+ ""
+ pure (ReviewReady commitSha (Text.pack diffOut))
+
+findCommitForTask :: Text -> IO (Maybe Text)
+findCommitForTask tid = 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 pure Nothing
+ else case List.lines shaOut of
+ (x : _) -> pure (Just (Text.pack x))
+ [] -> pure Nothing
+
+checkMergeConflict :: String -> IO (Maybe [Text])
+checkMergeConflict commitSha = do
+ (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""
+
+ (cpCode, _, cpErr) <-
+ Process.readProcessWithExitCode
+ "git"
+ ["cherry-pick", "--no-commit", commitSha]
+ ""
+
+ _ <- 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
+ let errLines = Text.lines (Text.pack cpErr)
+ conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
+ files = mapMaybe extractConflictFile conflictLines
+ pure (Just (if null files then ["(unknown files)"] else files))
+
+extractConflictFile :: Text -> Maybe Text
+extractConflictFile line =
+ 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
+
app :: Application
app = serve api server