summaryrefslogtreecommitdiff
path: root/Omni/Jr
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr')
-rw-r--r--Omni/Jr/Web.hs162
-rw-r--r--Omni/Jr/Web/Style.hs41
2 files changed, 199 insertions, 4 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 3c24d71..5fc8126 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -21,10 +21,11 @@ import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
-import Data.Time (UTCTime, defaultTimeLocale, formatTime)
+import Data.Time (UTCTime, defaultTimeLocale, diffUTCTime, formatTime)
import qualified Lucid
import qualified Lucid.Base as Lucid
import qualified Network.Wai.Handler.Warp as Warp
+import Numeric (showFFloat)
import qualified Omni.Jr.Web.Style as Style
import qualified Omni.Task.Core as TaskCore
import Servant
@@ -71,6 +72,7 @@ type API =
:> QueryParam "priority" Text
:> QueryParam "namespace" Text
:> Get '[Lucid.HTML] TaskListPartial
+ :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
data CSS
@@ -91,7 +93,7 @@ newtype InterventionPage = InterventionPage [TaskCore.Task]
data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters
data TaskDetailPage
- = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity]
+ = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext)
| TaskDetailNotFound Text
data TaskReviewPage
@@ -113,6 +115,8 @@ data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
newtype TaskListPartial = TaskListPartial [TaskCore.Task]
+data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext)
+
newtype RejectForm = RejectForm (Maybe Text)
instance FromForm RejectForm where
@@ -402,7 +406,7 @@ instance Lucid.ToHtml TaskDetailPage where
"The task "
Lucid.code_ (Lucid.toHtml tid)
" could not be found."
- toHtml (TaskDetailFound task allTasks activities) =
+ toHtml (TaskDetailFound task allTasks activities maybeRetry) =
Lucid.doctypehtml_ <| do
pageHead (TaskCore.taskId task <> " - Jr")
Lucid.body_ <| do
@@ -492,6 +496,21 @@ instance Lucid.ToHtml TaskDetailPage where
Lucid.ul_ [Lucid.class_ "child-list"] <| do
traverse_ renderChild children
+ let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities
+ when hasRunningActivity <| do
+ let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress
+ htmxAttrs =
+ [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> TaskCore.taskId task <> "/metrics"),
+ Lucid.makeAttribute "hx-trigger" "every 5s",
+ Lucid.makeAttribute "hx-swap" "innerHTML"
+ ]
+ sectionAttrs =
+ [Lucid.class_ "execution-section", Lucid.id_ "execution-details"]
+ <> [attr | isInProgress, attr <- htmxAttrs]
+ Lucid.div_ sectionAttrs <| do
+ Lucid.h3_ "Execution Details"
+ renderExecutionDetails (TaskCore.taskId task) activities maybeRetry
+
when (TaskCore.taskStatus task == TaskCore.InProgress && not (null activities)) <| do
Lucid.div_ [Lucid.class_ "activity-section"] <| do
Lucid.h3_ "Activity Timeline"
@@ -566,6 +585,64 @@ instance Lucid.ToHtml TaskDetailPage where
formatTimestamp :: UTCTime -> Text
formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+ renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
+ renderExecutionDetails _ acts retryCtx =
+ case findRunningAct acts of
+ Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
+ Just act ->
+ Lucid.div_ [Lucid.class_ "execution-details"] <| do
+ case TaskCore.activityAmpThreadUrl act of
+ Nothing -> pure ()
+ Just url ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:"
+ Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "metric-value amp-link"] (Lucid.toHtml url)
+
+ case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
+ (Just start, Just end) ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDur start end))
+ (Just start, Nothing) ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp start))
+ _ -> pure ()
+
+ case TaskCore.activityCostCents act of
+ Nothing -> pure ()
+ Just cents ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal cents))
+
+ case retryCtx of
+ Nothing -> pure ()
+ Just ctx ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
+ Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
+
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act)))
+ where
+ findRunningAct = List.find (\a -> TaskCore.activityStage a == TaskCore.Running)
+
+ formatDur :: UTCTime -> UTCTime -> Text
+ formatDur start end =
+ let diffSecs = floor (diffUTCTime end start) :: Int
+ mins = diffSecs `div` 60
+ secs = diffSecs `mod` 60
+ in if mins > 0
+ then tshow mins <> "m " <> tshow secs <> "s"
+ else tshow secs <> "s"
+
+ formatCostVal :: Int -> Text
+ formatCostVal cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
instance Lucid.ToHtml TaskReviewPage where
toHtmlRaw = Lucid.toHtml
toHtml (ReviewPageNotFound tid) =
@@ -772,6 +849,75 @@ instance Lucid.ToHtml TaskListPartial where
then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
+instance Lucid.ToHtml TaskMetricsPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (TaskMetricsPartial _tid activities maybeRetry) =
+ Lucid.div_ [Lucid.class_ "execution-details"] <| do
+ case findRunningActivity activities of
+ Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
+ Just act -> do
+ case TaskCore.activityAmpThreadUrl act of
+ Nothing -> pure ()
+ Just url ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:"
+ Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "metric-value amp-link"] (Lucid.toHtml url)
+
+ case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
+ (Just start, Just end) ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration start end))
+ (Just start, Nothing) ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp start))
+ _ -> pure ()
+
+ case TaskCore.activityCostCents act of
+ Nothing -> pure ()
+ Just cents ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost cents))
+
+ case TaskCore.activityTokensUsed act of
+ Nothing -> pure ()
+ Just tokens ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Tokens:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow tokens))
+
+ case maybeRetry of
+ Nothing -> pure ()
+ Just ctx ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
+ Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
+
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act)))
+ where
+ findRunningActivity = List.find (\a -> TaskCore.activityStage a == TaskCore.Running)
+
+ formatTimestamp :: UTCTime -> Text
+ formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+
+ formatDuration :: UTCTime -> UTCTime -> Text
+ formatDuration start end =
+ let diffSecs = floor (diffUTCTime end start) :: Int
+ mins = diffSecs `div` 60
+ secs = diffSecs `mod` 60
+ in if mins > 0
+ then tshow mins <> "m " <> tshow secs <> "s"
+ else tshow secs <> "s"
+
+ formatCost :: Int -> Text
+ formatCost cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
-- | Simple markdown renderer for epic descriptions
-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
@@ -904,6 +1050,7 @@ server =
:<|> recentActivityHandler
:<|> readyCountHandler
:<|> taskListPartialHandler
+ :<|> taskMetricsPartialHandler
where
styleHandler :: Servant.Handler LazyText.Text
styleHandler = pure Style.css
@@ -988,7 +1135,8 @@ server =
Nothing -> pure (TaskDetailNotFound tid)
Just task -> do
activities <- liftIO (TaskCore.getActivitiesForTask tid)
- pure (TaskDetailFound task tasks activities)
+ retryCtx <- liftIO (TaskCore.getRetryContext tid)
+ pure (TaskDetailFound task tasks activities retryCtx)
taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
taskStatusHandler tid (StatusForm newStatus) = do
@@ -1056,6 +1204,12 @@ server =
filteredTasks = applyFilters filters allTasks
pure (TaskListPartial filteredTasks)
+ taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
+ taskMetricsPartialHandler tid = do
+ activities <- liftIO (TaskCore.getActivitiesForTask tid)
+ maybeRetry <- liftIO (TaskCore.getRetryContext tid)
+ pure (TaskMetricsPartial tid activities maybeRetry)
+
getReviewInfo :: Text -> IO ReviewInfo
getReviewInfo tid = do
maybeCommit <- findCommitForTask tid
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index dbe1daa..b4f4c76 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -28,6 +28,7 @@ stylesheet = do
statusBadges
buttonStyles
formStyles
+ executionDetailsStyles
activityTimelineStyles
markdownStyles
responsiveStyles
@@ -497,6 +498,39 @@ formStyles = do
".form-actions" ? do
marginTop (px 8)
+executionDetailsStyles :: Css
+executionDetailsStyles = do
+ ".execution-section" ? do
+ marginTop (em 1)
+ backgroundColor white
+ borderRadius (px 2) (px 2) (px 2) (px 2)
+ padding (px 8) (px 10) (px 8) (px 10)
+ border (px 1) solid "#d0d0d0"
+ ".execution-details" ? do
+ marginTop (px 8)
+ ".metric-row" ? do
+ display flex
+ flexWrap Flexbox.wrap
+ padding (px 4) (px 0) (px 4) (px 0)
+ borderBottom (px 1) solid "#e5e7eb"
+ ".metric-row" # lastChild ? borderBottom (px 0) none transparent
+ ".metric-label" ? do
+ fontWeight (weight 600)
+ width (px 120)
+ color "#6b7280"
+ fontSize (px 13)
+ ".metric-value" ? do
+ Stylesheet.key "flex" ("1" :: Text)
+ fontSize (px 13)
+ ".amp-link" ? do
+ color "#0066cc"
+ textDecoration none
+ wordBreak breakAll
+ ".amp-link" # hover ? textDecoration underline
+ ".retry-count" ? do
+ color "#f97316"
+ fontWeight (weight 600)
+
activityTimelineStyles :: Css
activityTimelineStyles = do
".activity-section" ? do
@@ -751,6 +785,13 @@ darkModeStyles =
".activity-message" ? color "#d1d5db"
(".activity-metadata" |> "summary") ? color "#9ca3af"
".metadata-json" ? backgroundColor "#374151"
+ ".execution-section" ? do
+ backgroundColor "#1f2937"
+ borderColor "#374151"
+ ".metric-row" ? borderBottomColor "#374151"
+ ".metric-label" ? color "#9ca3af"
+ ".metric-value" ? color "#d1d5db"
+ ".amp-link" ? color "#60a5fa"
".markdown-content" ? color "#d1d5db"
".md-h1" ? borderBottomColor "#374151"
".md-inline-code" ? do
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 21:22:53 +0000