1 files changed, 274 insertions, 0 deletions
diff --git a/Omni/Jr/Web/Partials.hs b/Omni/Jr/Web/Partials.hs
new file mode 100644
index 0000000..2660441
--- /dev/null
+++ b/Omni/Jr/Web/Partials.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- : 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
+  ( aggregateCostMetrics,
+    commentForm,
+    complexityBadgeWithForm,
+    formatCostHeader,
+    formatTokensHeader,
+    metaSep,
+    priorityBadgeWithForm,
+    renderAutoscrollToggle,
+    renderListGroupItem,
+    renderLiveToggle,
+    renderMarkdown,
+    renderRelativeTimestamp,
+    renderTimelineEvent,
+    statusBadgeWithForm,
+    timelineScrollScript,
+  )
+import Omni.Jr.Web.Types
+  ( AgentEventsPartial (..),
+    ComplexityBadgePartial (..),
+    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 ComplexityBadgePartial where
+  toHtmlRaw = Lucid.toHtml
+  toHtml (ComplexityBadgePartial complexity tid) =
+    complexityBadgeWithForm complexity 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 tid events isInProgress now) = do
+    let nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
+        eventCount = length nonCostEvents
+        (totalCents, totalTokens) = aggregateCostMetrics events
+    Lucid.h3_ <| do
+      Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")")
+      when (totalCents > 0 || totalTokens > 0) <| do
+        Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do
+          metaSep
+          when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents)
+          when (totalCents > 0 && totalTokens > 0) <| metaSep
+          when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens")
+      when isInProgress <| do
+        renderLiveToggle
+        renderAutoscrollToggle
+    if null nonCostEvents
+      then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
+      else do
+        Lucid.div_ [Lucid.class_ "timeline-events"] <| do
+          traverse_ (renderTimelineEvent now) nonCostEvents
+        when isInProgress <| timelineScrollScript
+    commentForm tid