summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr/Web.hs')
-rw-r--r--Omni/Jr/Web.hs48
1 files changed, 48 insertions, 0 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index b751ee9..6d0fa20 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -429,6 +429,8 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.div_ [Lucid.class_ "container"] <| do
Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
+ renderRetryContextBanner maybeRetry
+
Lucid.div_ [Lucid.class_ "task-detail"] <| do
Lucid.div_ [Lucid.class_ "detail-row"] <| do
Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
@@ -679,6 +681,52 @@ 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) =
+ Lucid.div_ [Lucid.class_ bannerClass] <| do
+ Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do
+ Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon
+ Lucid.span_ [Lucid.class_ "retry-attempt"] (Lucid.toHtml attemptText)
+ when maxRetriesExceeded
+ <| Lucid.span_ [Lucid.class_ "retry-warning-badge"] "Needs Human Intervention"
+
+ Lucid.div_ [Lucid.class_ "retry-banner-details"] <| do
+ Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "retry-label"] "Failure Reason:"
+ Lucid.span_ [Lucid.class_ "retry-value"] (Lucid.toHtml (summarizeReason (TaskCore.retryReason ctx)))
+
+ let commit = TaskCore.retryOriginalCommit ctx
+ unless (Text.null commit) <| do
+ Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "retry-label"] "Original Commit:"
+ Lucid.code_ [Lucid.class_ "retry-commit"] (Lucid.toHtml (Text.take 8 commit))
+
+ let conflicts = TaskCore.retryConflictFiles ctx
+ unless (null conflicts) <| do
+ Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "retry-label"] "Conflict Files:"
+ Lucid.ul_ [Lucid.class_ "retry-conflict-list"]
+ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts
+
+ when maxRetriesExceeded
+ <| 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."
+ where
+ attempt = TaskCore.retryAttempt ctx
+ maxRetriesExceeded = attempt >= 3
+ bannerClass = if maxRetriesExceeded then "retry-banner retry-banner-critical" else "retry-banner retry-banner-warning"
+ retryIcon = if maxRetriesExceeded then "⚠" else "↻"
+ attemptText = "Attempt " <> tshow attempt <> " of 3"
+
+ summarizeReason :: Text -> Text
+ summarizeReason reason
+ | "rejected:" `Text.isPrefixOf` reason = "Rejected: " <> Text.strip (Text.drop 9 reason)
+ | "Test failure:" `Text.isPrefixOf` reason = "Test failure (see details below)"
+ | "MERGE CONFLICT" `Text.isPrefixOf` reason = "Merge conflict with concurrent changes"
+ | otherwise = Text.take 100 reason <> if Text.length reason > 100 then "..." else ""
+
instance Lucid.ToHtml TaskReviewPage where
toHtmlRaw = Lucid.toHtml
toHtml (ReviewPageNotFound tid) =