diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 51 |
1 files changed, 44 insertions, 7 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 00e0c88..52306c2 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -61,6 +61,7 @@ type API = :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect @@ -153,6 +154,13 @@ instance FromForm DescriptionForm where desc <- parseUnique "description" form Right (DescriptionForm desc) +newtype NotesForm = NotesForm Text + +instance FromForm NotesForm where + fromForm form = do + notes <- parseUnique "notes" form + Right (NotesForm notes) + pageHead :: (Monad m) => Text -> Lucid.HtmlT m () pageHead title = Lucid.head_ <| do @@ -429,7 +437,7 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.div_ [Lucid.class_ "container"] <| do Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task) - renderRetryContextBanner maybeRetry + renderRetryContextBanner (TaskCore.taskId task) maybeRetry Lucid.div_ [Lucid.class_ "task-detail"] <| do Lucid.div_ [Lucid.class_ "detail-row"] <| do @@ -681,9 +689,9 @@ instance Lucid.ToHtml TaskDetailPage where let dollars = fromIntegral cents / 100.0 :: Double in "$" <> Text.pack (showFFloat (Just 2) dollars "") -renderRetryContextBanner :: (Monad m) => Maybe TaskCore.RetryContext -> Lucid.HtmlT m () -renderRetryContextBanner Nothing = pure () -renderRetryContextBanner (Just ctx) = +renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m () +renderRetryContextBanner _ Nothing = pure () +renderRetryContextBanner tid (Just ctx) = Lucid.div_ [Lucid.class_ bannerClass] <| do Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon @@ -709,10 +717,32 @@ renderRetryContextBanner (Just ctx) = Lucid.ul_ [Lucid.class_ "retry-conflict-list"] <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts - when maxRetriesExceeded - <| Lucid.div_ + when maxRetriesExceeded <| do + Lucid.div_ [Lucid.class_ "retry-warning-message"] "This task has exceeded the maximum number of retries. A human must review the failure and either fix the issue manually or reset the retry count." + + Lucid.div_ [Lucid.class_ "retry-notes-section"] <| do + Lucid.h4_ "Human Notes/Guidance" + Lucid.p_ [Lucid.class_ "notes-help"] "Add notes to guide the worker on the next retry attempt:" + Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/notes")] <| do + Lucid.textarea_ + [ Lucid.name_ "notes", + Lucid.class_ "notes-textarea", + Lucid.rows_ "6", + Lucid.placeholder_ "Provide guidance for the worker: what to fix, which approach to use, or what to avoid..." + ] + (Lucid.toHtml (fromMaybe "" (TaskCore.retryNotes ctx))) + Lucid.div_ [Lucid.class_ "form-actions"] <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Notes" + + case TaskCore.retryNotes ctx of + Nothing -> pure () + Just notes -> + unless maxRetriesExceeded <| do + Lucid.div_ [Lucid.class_ "retry-notes-display"] <| do + Lucid.h4_ "Human Notes" + Lucid.div_ [Lucid.class_ "notes-content"] (Lucid.toHtml notes) where attempt = TaskCore.retryAttempt ctx maxRetriesExceeded = attempt >= 3 @@ -1154,6 +1184,7 @@ server = :<|> taskDetailHandler :<|> taskStatusHandler :<|> taskDescriptionHandler + :<|> taskNotesHandler :<|> taskReviewHandler :<|> taskDiffHandler :<|> taskAcceptHandler @@ -1261,6 +1292,11 @@ server = _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descMaybe}) pure <| addHeader ("/tasks/" <> tid) NoContent + taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskNotesHandler tid (NotesForm notes) = do + liftIO <| TaskCore.updateRetryNotes tid notes + pure <| addHeader ("/tasks/" <> tid) NoContent + taskReviewHandler :: Text -> Servant.Handler TaskReviewPage taskReviewHandler tid = do tasks <- liftIO TaskCore.loadTasks @@ -1298,7 +1334,8 @@ server = TaskCore.retryOriginalCommit = commitSha, TaskCore.retryConflictFiles = [], TaskCore.retryAttempt = attempt, - TaskCore.retryReason = reason + TaskCore.retryReason = reason, + TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes } TaskCore.updateTaskStatus tid TaskCore.Open [] pure <| addHeader ("/tasks/" <> tid) NoContent |