summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web/Partials.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bensima.com>2025-12-01 18:44:47 -0500
committerBen Sima <ben@bensima.com>2025-12-01 18:44:47 -0500
commitdbbad7cff74411b39db6d619a2a1ad6512aad634 (patch)
treee205780cbe8ff065872f14f6095054084dc90c0e /Omni/Jr/Web/Partials.hs
parent838350a9afc27618abf9a78e721eb8902e99b6ab (diff)
Refactor Web.hs into smaller modules
Split 3231-line Web.hs into focused submodules: - Types.hs (346 lines): Data types, forms, API definition - Components.hs (1464 lines): Reusable UI components - Pages.hs (866 lines): Full page ToHtml instances - Partials.hs (247 lines): HTMX partial ToHtml instances - Handlers.hs (642 lines): Servant handler implementations - Web.hs (39 lines): Main module with run function Reduces main file by 99%, preventing agent token bloat. Task-Id: t-226 Amp-Thread-ID: https://ampcode.com/threads/T-355fae3a-03e9-4bdb-a1c7-6132576bf601 Co-authored-by: Amp <amp@ampcode.com>
Diffstat (limited to 'Omni/Jr/Web/Partials.hs')
-rw-r--r--Omni/Jr/Web/Partials.hs247
1 files changed, 247 insertions, 0 deletions
diff --git a/Omni/Jr/Web/Partials.hs b/Omni/Jr/Web/Partials.hs
new file mode 100644
index 0000000..79c997e
--- /dev/null
+++ b/Omni/Jr/Web/Partials.hs
@@ -0,0 +1,247 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- : dep lucid
+-- : dep servant-lucid
+module Omni.Jr.Web.Partials
+ ( -- Re-export instances for use by Web.hs
+ )
+where
+
+import Alpha
+import qualified Data.Text as Text
+import Data.Time (UTCTime, diffUTCTime)
+import qualified Lucid
+import qualified Lucid.Base as Lucid
+import Numeric (showFFloat)
+import Omni.Jr.Web.Components
+ ( priorityBadgeWithForm,
+ renderListGroupItem,
+ renderMarkdown,
+ renderRelativeTimestamp,
+ renderTimelineEvent,
+ statusBadgeWithForm,
+ timelineScrollScript,
+ )
+import Omni.Jr.Web.Types
+ ( AgentEventsPartial (..),
+ DescriptionEditPartial (..),
+ DescriptionViewPartial (..),
+ PriorityBadgePartial (..),
+ ReadyCountPartial (..),
+ RecentActivityMorePartial (..),
+ RecentActivityNewPartial (..),
+ StatusBadgePartial (..),
+ TaskListPartial (..),
+ TaskMetricsPartial (..),
+ )
+import qualified Omni.Task.Core as TaskCore
+
+instance Lucid.ToHtml RecentActivityNewPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (RecentActivityNewPartial tasks maybeNewestTs) = do
+ traverse_ renderListGroupItem tasks
+ case maybeNewestTs of
+ Nothing -> pure ()
+ Just ts ->
+ Lucid.div_
+ [ Lucid.id_ "recent-activity",
+ Lucid.makeAttribute "data-newest-ts" (tshow ts),
+ Lucid.makeAttribute "hx-swap-oob" "attributes:#recent-activity data-newest-ts"
+ ]
+ ""
+
+instance Lucid.ToHtml RecentActivityMorePartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (RecentActivityMorePartial tasks nextOffset hasMore) = do
+ traverse_ renderListGroupItem tasks
+ if hasMore
+ then
+ Lucid.button_
+ [ Lucid.id_ "activity-load-more",
+ Lucid.class_ "btn btn-secondary load-more-btn",
+ Lucid.makeAttribute "hx-get" ("/partials/recent-activity-more?offset=" <> tshow nextOffset),
+ Lucid.makeAttribute "hx-target" "#activity-list",
+ Lucid.makeAttribute "hx-swap" "beforeend",
+ Lucid.makeAttribute "hx-swap-oob" "true"
+ ]
+ "Load More"
+ else Lucid.span_ [Lucid.id_ "activity-load-more", Lucid.makeAttribute "hx-swap-oob" "true"] ""
+
+instance Lucid.ToHtml ReadyCountPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (ReadyCountPartial count) =
+ Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
+ <| Lucid.toHtml ("(" <> tshow count <> " tasks)")
+
+instance Lucid.ToHtml StatusBadgePartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (StatusBadgePartial status tid) =
+ statusBadgeWithForm status tid
+
+instance Lucid.ToHtml PriorityBadgePartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (PriorityBadgePartial priority tid) =
+ priorityBadgeWithForm priority tid
+
+instance Lucid.ToHtml TaskListPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (TaskListPartial tasks) =
+ if null tasks
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
+ else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
+
+instance Lucid.ToHtml TaskMetricsPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (TaskMetricsPartial _tid activities maybeRetry now) =
+ let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities
+ in if null runningActs
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
+ else
+ Lucid.div_ [Lucid.class_ "execution-details"] <| do
+ let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
+ totalDuration = sum [calcDurSecs act | act <- runningActs]
+ attemptCount = length runningActs
+
+ 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"))
+
+ when (attemptCount > 1) <| do
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
+ when (totalCost > 0)
+ <| Lucid.div_ [Lucid.class_ "metric-row"]
+ <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost totalCost))
+ Lucid.hr_ [Lucid.class_ "attempts-divider"]
+
+ traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs))
+ where
+ calcDurSecs :: TaskCore.TaskActivity -> Int
+ calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
+ (Just start, Just end) -> floor (diffUTCTime end start)
+ _ -> 0
+
+ formatDurSecs :: Int -> Text
+ formatDurSecs secs
+ | secs < 60 = tshow secs <> "s"
+ | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
+ | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"
+
+ renderAttempt :: (Monad m) => Int -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
+ renderAttempt totalAttempts currentTime (attemptNum, act) = do
+ when (totalAttempts > 1)
+ <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
+ case TaskCore.activityThreadUrl act of
+ Nothing -> pure ()
+ Just url ->
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Session:"
+ Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"
+
+ 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"] (renderRelativeTimestamp currentTime 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))
+
+ Lucid.div_ [Lucid.class_ "metric-row"] <| do
+ Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
+ Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act))
+
+ 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 "")
+
+instance Lucid.ToHtml DescriptionViewPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (DescriptionViewPartial tid desc isEpic) =
+ Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block"] <| do
+ Lucid.div_ [Lucid.class_ "description-header"] <| do
+ Lucid.h3_ (if isEpic then "Design" else "Description")
+ Lucid.a_
+ [ Lucid.href_ "#",
+ Lucid.class_ "edit-link",
+ Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"),
+ Lucid.makeAttribute "hx-target" "#description-block",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ "Edit"
+ if Text.null desc
+ then Lucid.p_ [Lucid.class_ "empty-msg"] (if isEpic then "No design document yet." else "No description yet.")
+ else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
+
+instance Lucid.ToHtml DescriptionEditPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (DescriptionEditPartial tid desc isEpic) =
+ Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block editing"] <| do
+ Lucid.div_ [Lucid.class_ "description-header"] <| do
+ Lucid.h3_ (if isEpic then "Design" else "Description")
+ Lucid.button_
+ [ Lucid.type_ "button",
+ Lucid.class_ "cancel-link",
+ Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"),
+ Lucid.makeAttribute "hx-target" "#description-block",
+ Lucid.makeAttribute "hx-swap" "outerHTML",
+ Lucid.makeAttribute "hx-confirm" "Discard changes?"
+ ]
+ "Cancel"
+ Lucid.form_
+ [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"),
+ Lucid.makeAttribute "hx-target" "#description-block",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ <| do
+ Lucid.textarea_
+ [ Lucid.name_ "description",
+ Lucid.class_ "description-textarea",
+ Lucid.rows_ (if isEpic then "15" else "10"),
+ Lucid.placeholder_ (if isEpic then "Enter design in Markdown..." else "Enter description...")
+ ]
+ (Lucid.toHtml desc)
+ Lucid.div_ [Lucid.class_ "form-actions"] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save"
+
+instance Lucid.ToHtml AgentEventsPartial where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (AgentEventsPartial events isInProgress now) = do
+ Lucid.h3_ <| do
+ Lucid.toHtml ("Timeline (" <> tshow (length events) <> ")")
+ when isInProgress <| Lucid.span_ [Lucid.class_ "timeline-live"] " LIVE"
+ if null events
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
+ else do
+ Lucid.div_ [Lucid.class_ "timeline-events"] <| do
+ traverse_ (renderTimelineEvent now) events
+ timelineScrollScript