summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web/Components.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr/Web/Components.hs')
-rw-r--r--Omni/Jr/Web/Components.hs1464
1 files changed, 1464 insertions, 0 deletions
diff --git a/Omni/Jr/Web/Components.hs b/Omni/Jr/Web/Components.hs
new file mode 100644
index 0000000..9c32cf2
--- /dev/null
+++ b/Omni/Jr/Web/Components.hs
@@ -0,0 +1,1464 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- : dep lucid
+-- : dep servant-lucid
+module Omni.Jr.Web.Components
+ ( -- * Time formatting
+ formatRelativeTime,
+ relativeText,
+ formatExactTimestamp,
+ renderRelativeTimestamp,
+
+ -- * Small components
+ metaSep,
+
+ -- * Page layout
+ pageHead,
+ pageBody,
+ pageBodyWithCrumbs,
+ navbar,
+
+ -- * JavaScript
+ navbarDropdownJs,
+ statusDropdownJs,
+ priorityDropdownJs,
+ liveToggleJs,
+
+ -- * Breadcrumbs
+ Breadcrumb (..),
+ Breadcrumbs,
+ renderBreadcrumbs,
+ getAncestors,
+ taskBreadcrumbs,
+
+ -- * Badges
+ statusBadge,
+ complexityBadge,
+ statusBadgeWithForm,
+ clickableBadge,
+ statusDropdownOptions,
+ statusOption,
+ priorityBadgeWithForm,
+ clickablePriorityBadge,
+ priorityDropdownOptions,
+ priorityOption,
+
+ -- * Sorting
+ SortOrder (..),
+ sortOrderToParam,
+ sortOrderLabel,
+ sortDropdown,
+ sortOption,
+
+ -- * Progress bars
+ multiColorProgressBar,
+ epicProgressBar,
+
+ -- * Task rendering
+ renderTaskCard,
+ renderBlockedTaskCard,
+ renderListGroupItem,
+ renderEpicReviewCard,
+ renderEpicCardWithStats,
+ getDescendants,
+
+ -- * Metrics
+ renderAggregatedMetrics,
+
+ -- * Retry context
+ renderRetryContextBanner,
+
+ -- * Markdown
+ MarkdownBlock (..),
+ InlinePart (..),
+ renderMarkdown,
+ parseBlocks,
+ renderBlocks,
+ renderBlock,
+ renderListItem,
+ renderInline,
+ parseInline,
+ parseBold,
+ renderInlineParts,
+ renderInlinePart,
+
+ -- * Comments
+ commentForm,
+
+ -- * Live toggles
+ renderLiveToggle,
+ renderAutoscrollToggle,
+
+ -- * Cost/Token metrics
+ aggregateCostMetrics,
+ formatCostHeader,
+ formatTokensHeader,
+
+ -- * Timeline
+ renderUnifiedTimeline,
+ renderTimelineEvent,
+ eventTypeIconAndLabel,
+ renderActorLabel,
+ renderCommentTimelineEvent,
+ renderStatusChangeEvent,
+ parseStatusChange,
+ renderActivityEvent,
+ renderErrorTimelineEvent,
+ renderAssistantTimelineEvent,
+ renderToolCallTimelineEvent,
+ renderToolResultTimelineEvent,
+ renderCheckpointEvent,
+ renderGuardrailEvent,
+ renderGenericEvent,
+ parseToolCallContent,
+ formatToolCallSummary,
+ renderCollapsibleOutput,
+ renderDecodedToolResult,
+ timelineScrollScript,
+ )
+where
+
+import Alpha
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.List as List
+import qualified Data.Text as Text
+import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime)
+import qualified Lucid
+import qualified Lucid.Base as Lucid
+import Numeric (showFFloat)
+import qualified Omni.Task.Core as TaskCore
+
+-- * Time formatting
+
+formatRelativeTime :: UTCTime -> UTCTime -> Text
+formatRelativeTime now timestamp =
+ let delta = diffUTCTime now timestamp
+ in relativeText delta
+
+relativeText :: NominalDiffTime -> Text
+relativeText delta
+ | delta < 60 = "just now"
+ | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
+ | delta < 7200 = "1 hour ago"
+ | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
+ | delta < 172800 = "yesterday"
+ | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
+ | delta < 1209600 = "1 week ago"
+ | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
+ | delta < 5184000 = "1 month ago"
+ | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
+ | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"
+
+formatExactTimestamp :: UTCTime -> Text
+formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
+
+renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderRelativeTimestamp now timestamp =
+ Lucid.span_
+ [ Lucid.class_ "relative-time",
+ Lucid.title_ (formatExactTimestamp timestamp)
+ ]
+ (Lucid.toHtml (formatRelativeTime now timestamp))
+
+-- * Small components
+
+metaSep :: (Monad m) => Lucid.HtmlT m ()
+metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
+
+-- * Sort types
+
+data SortOrder
+ = SortNewest
+ | SortOldest
+ | SortUpdated
+ | SortPriorityHigh
+ | SortPriorityLow
+ deriving (Show, Eq)
+
+sortOrderToParam :: SortOrder -> Text
+sortOrderToParam SortNewest = "newest"
+sortOrderToParam SortOldest = "oldest"
+sortOrderToParam SortUpdated = "updated"
+sortOrderToParam SortPriorityHigh = "priority-high"
+sortOrderToParam SortPriorityLow = "priority-low"
+
+sortOrderLabel :: SortOrder -> Text
+sortOrderLabel SortNewest = "Newest First"
+sortOrderLabel SortOldest = "Oldest First"
+sortOrderLabel SortUpdated = "Recently Updated"
+sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
+sortOrderLabel SortPriorityLow = "Priority (Low to High)"
+
+-- * Page layout
+
+pageHead :: (Monad m) => Text -> Lucid.HtmlT m ()
+pageHead title =
+ Lucid.head_ <| do
+ Lucid.title_ (Lucid.toHtml title)
+ Lucid.meta_ [Lucid.charset_ "utf-8"]
+ Lucid.meta_
+ [ Lucid.name_ "viewport",
+ Lucid.content_ "width=device-width, initial-scale=1"
+ ]
+ Lucid.link_ [Lucid.rel_ "stylesheet", Lucid.href_ "/style.css"]
+ Lucid.script_
+ [ Lucid.src_ "https://unpkg.com/htmx.org@2.0.4",
+ Lucid.integrity_ "sha384-HGfztofotfshcF7+8n44JQL2oJmowVChPTg48S+jvZoztPfvwD79OC/LTtG6dMp+",
+ Lucid.crossorigin_ "anonymous"
+ ]
+ ("" :: Text)
+ Lucid.script_ [] statusDropdownJs
+ Lucid.script_ [] priorityDropdownJs
+ Lucid.script_ [] navbarDropdownJs
+ Lucid.script_ [] liveToggleJs
+
+-- * JavaScript
+
+navbarDropdownJs :: Text
+navbarDropdownJs =
+ Text.unlines
+ [ "document.addEventListener('DOMContentLoaded', function() {",
+ " document.querySelectorAll('.navbar-dropdown-btn').forEach(function(btn) {",
+ " btn.addEventListener('click', function(e) {",
+ " e.preventDefault();",
+ " var dropdown = btn.closest('.navbar-dropdown');",
+ " var isOpen = dropdown.classList.contains('open');",
+ " document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
+ " d.classList.remove('open');",
+ " });",
+ " if (!isOpen) {",
+ " dropdown.classList.add('open');",
+ " }",
+ " });",
+ " });",
+ " document.addEventListener('click', function(e) {",
+ " if (!e.target.closest('.navbar-dropdown')) {",
+ " document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
+ " d.classList.remove('open');",
+ " });",
+ " }",
+ " });",
+ "});"
+ ]
+
+statusDropdownJs :: Text
+statusDropdownJs =
+ Text.unlines
+ [ "function toggleStatusDropdown(el) {",
+ " var container = el.parentElement;",
+ " var isOpen = container.classList.toggle('open');",
+ " el.setAttribute('aria-expanded', isOpen);",
+ " if (isOpen) {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ "}",
+ "",
+ "function closeStatusDropdown(container) {",
+ " container.classList.remove('open');",
+ " var badge = container.querySelector('[role=\"button\"]');",
+ " if (badge) {",
+ " badge.setAttribute('aria-expanded', 'false');",
+ " badge.focus();",
+ " }",
+ "}",
+ "",
+ "function handleStatusKeydown(event, el) {",
+ " if (event.key === 'Enter' || event.key === ' ') {",
+ " event.preventDefault();",
+ " toggleStatusDropdown(el);",
+ " } else if (event.key === 'Escape') {",
+ " closeStatusDropdown(el.parentElement);",
+ " } else if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var container = el.parentElement;",
+ " if (!container.classList.contains('open')) {",
+ " toggleStatusDropdown(el);",
+ " } else {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ " }",
+ "}",
+ "",
+ "function handleMenuItemKeydown(event) {",
+ " var container = event.target.closest('.status-badge-dropdown');",
+ " var items = container.querySelectorAll('[role=\"menuitem\"]');",
+ " var currentIndex = Array.from(items).indexOf(event.target);",
+ " ",
+ " if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var next = (currentIndex + 1) % items.length;",
+ " items[next].focus();",
+ " } else if (event.key === 'ArrowUp') {",
+ " event.preventDefault();",
+ " var prev = (currentIndex - 1 + items.length) % items.length;",
+ " items[prev].focus();",
+ " } else if (event.key === 'Escape') {",
+ " event.preventDefault();",
+ " closeStatusDropdown(container);",
+ " } else if (event.key === 'Tab') {",
+ " closeStatusDropdown(container);",
+ " }",
+ "}",
+ "",
+ "document.addEventListener('click', function(e) {",
+ " var dropdowns = document.querySelectorAll('.status-badge-dropdown.open');",
+ " dropdowns.forEach(function(d) {",
+ " if (!d.contains(e.target)) {",
+ " closeStatusDropdown(d);",
+ " }",
+ " });",
+ "});"
+ ]
+
+priorityDropdownJs :: Text
+priorityDropdownJs =
+ Text.unlines
+ [ "function togglePriorityDropdown(el) {",
+ " var container = el.parentElement;",
+ " var isOpen = container.classList.toggle('open');",
+ " el.setAttribute('aria-expanded', isOpen);",
+ " if (isOpen) {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ "}",
+ "",
+ "function closePriorityDropdown(container) {",
+ " container.classList.remove('open');",
+ " var badge = container.querySelector('[role=\"button\"]');",
+ " if (badge) {",
+ " badge.setAttribute('aria-expanded', 'false');",
+ " badge.focus();",
+ " }",
+ "}",
+ "",
+ "function handlePriorityKeydown(event, el) {",
+ " if (event.key === 'Enter' || event.key === ' ') {",
+ " event.preventDefault();",
+ " togglePriorityDropdown(el);",
+ " } else if (event.key === 'Escape') {",
+ " closePriorityDropdown(el.parentElement);",
+ " } else if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var container = el.parentElement;",
+ " if (!container.classList.contains('open')) {",
+ " togglePriorityDropdown(el);",
+ " } else {",
+ " var firstItem = container.querySelector('[role=\"menuitem\"]');",
+ " if (firstItem) firstItem.focus();",
+ " }",
+ " }",
+ "}",
+ "",
+ "function handlePriorityMenuItemKeydown(event) {",
+ " var container = event.target.closest('.priority-badge-dropdown');",
+ " var items = container.querySelectorAll('[role=\"menuitem\"]');",
+ " var currentIndex = Array.from(items).indexOf(event.target);",
+ " ",
+ " if (event.key === 'ArrowDown') {",
+ " event.preventDefault();",
+ " var next = (currentIndex + 1) % items.length;",
+ " items[next].focus();",
+ " } else if (event.key === 'ArrowUp') {",
+ " event.preventDefault();",
+ " var prev = (currentIndex - 1 + items.length) % items.length;",
+ " items[prev].focus();",
+ " } else if (event.key === 'Escape') {",
+ " event.preventDefault();",
+ " closePriorityDropdown(container);",
+ " } else if (event.key === 'Tab') {",
+ " closePriorityDropdown(container);",
+ " }",
+ "}",
+ "",
+ "document.addEventListener('click', function(e) {",
+ " var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
+ " dropdowns.forEach(function(d) {",
+ " if (!d.contains(e.target)) {",
+ " closePriorityDropdown(d);",
+ " }",
+ " });",
+ "});"
+ ]
+
+liveToggleJs :: Text
+liveToggleJs =
+ Text.unlines
+ [ "var liveUpdatesEnabled = true;",
+ "var autoscrollEnabled = true;",
+ "",
+ "function toggleLiveUpdates() {",
+ " liveUpdatesEnabled = !liveUpdatesEnabled;",
+ " var btn = document.getElementById('live-toggle');",
+ " if (btn) {",
+ " btn.classList.toggle('timeline-live-paused', !liveUpdatesEnabled);",
+ " }",
+ "}",
+ "",
+ "function toggleAutoscroll() {",
+ " autoscrollEnabled = !autoscrollEnabled;",
+ " var btn = document.getElementById('autoscroll-toggle');",
+ " if (btn) {",
+ " btn.classList.toggle('timeline-autoscroll-disabled', !autoscrollEnabled);",
+ " }",
+ "}",
+ "",
+ "document.body.addEventListener('htmx:beforeRequest', function(evt) {",
+ " var timeline = document.getElementById('unified-timeline');",
+ " if (timeline && timeline.contains(evt.target) && !liveUpdatesEnabled) {",
+ " evt.preventDefault();",
+ " }",
+ "});",
+ "",
+ "document.body.addEventListener('htmx:afterSettle', function(evt) {",
+ " if (autoscrollEnabled) {",
+ " var log = document.querySelector('.timeline-events');",
+ " if (log) {",
+ " log.scrollTop = log.scrollHeight;",
+ " }",
+ " }",
+ "});"
+ ]
+
+pageBody :: (Monad m) => Lucid.HtmlT m () -> Lucid.HtmlT m ()
+pageBody content =
+ Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
+ navbar
+ content
+
+-- * Breadcrumbs
+
+data Breadcrumb = Breadcrumb
+ { _crumbLabel :: Text,
+ _crumbHref :: Maybe Text
+ }
+
+type Breadcrumbs = [Breadcrumb]
+
+pageBodyWithCrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m () -> Lucid.HtmlT m ()
+pageBodyWithCrumbs crumbs content =
+ Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
+ navbar
+ unless (null crumbs) <| do
+ Lucid.div_ [Lucid.class_ "breadcrumb-container"] <| do
+ Lucid.div_ [Lucid.class_ "container"] <| renderBreadcrumbs crumbs
+ content
+
+renderBreadcrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m ()
+renderBreadcrumbs [] = pure ()
+renderBreadcrumbs crumbs =
+ Lucid.nav_ [Lucid.class_ "breadcrumbs", Lucid.makeAttribute "aria-label" "Breadcrumb"] <| do
+ Lucid.ol_ [Lucid.class_ "breadcrumb-list"] <| do
+ traverse_ renderCrumb (zip [0 ..] crumbs)
+ where
+ renderCrumb :: (Monad m') => (Int, Breadcrumb) -> Lucid.HtmlT m' ()
+ renderCrumb (idx, Breadcrumb label mHref) = do
+ Lucid.li_ [Lucid.class_ "breadcrumb-item"] <| do
+ when (idx > 0) <| Lucid.span_ [Lucid.class_ "breadcrumb-sep"] ">"
+ case mHref of
+ Just href -> Lucid.a_ [Lucid.href_ href] (Lucid.toHtml label)
+ Nothing -> Lucid.span_ [Lucid.class_ "breadcrumb-current"] (Lucid.toHtml label)
+
+getAncestors :: [TaskCore.Task] -> TaskCore.Task -> [TaskCore.Task]
+getAncestors allTasks task =
+ case TaskCore.taskParent task of
+ Nothing -> [task]
+ Just pid -> case TaskCore.findTask pid allTasks of
+ Nothing -> [task]
+ Just parent -> getAncestors allTasks parent ++ [task]
+
+taskBreadcrumbs :: [TaskCore.Task] -> TaskCore.Task -> Breadcrumbs
+taskBreadcrumbs allTasks task =
+ let ancestors = getAncestors allTasks task
+ taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
+ currentCrumb = Breadcrumb (TaskCore.taskId task) Nothing
+ in [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks")]
+ ++ taskCrumbs
+ ++ [currentCrumb]
+
+-- * Navbar
+
+navbar :: (Monad m) => Lucid.HtmlT m ()
+navbar =
+ Lucid.nav_ [Lucid.class_ "navbar"] <| do
+ Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Junior"
+ Lucid.input_
+ [ Lucid.type_ "checkbox",
+ Lucid.id_ "navbar-toggle",
+ Lucid.class_ "navbar-toggle-checkbox"
+ ]
+ Lucid.label_
+ [ Lucid.for_ "navbar-toggle",
+ Lucid.class_ "navbar-hamburger"
+ ]
+ <| do
+ Lucid.span_ [Lucid.class_ "hamburger-line"] ""
+ Lucid.span_ [Lucid.class_ "hamburger-line"] ""
+ Lucid.span_ [Lucid.class_ "hamburger-line"] ""
+ Lucid.div_ [Lucid.class_ "navbar-links"] <| do
+ Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
+ Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
+ Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Tasks ▾"
+ Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
+ Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
+ Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
+ Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Human Action"
+ Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
+ Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
+ Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
+ Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
+ Lucid.a_ [Lucid.href_ "/epics", Lucid.class_ "navbar-dropdown-item"] "Epics"
+ Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
+ Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
+
+-- * Badges
+
+statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
+statusBadge status =
+ let (cls, label) = case status of
+ TaskCore.Draft -> ("badge badge-draft", "Draft")
+ TaskCore.Open -> ("badge badge-open", "Open")
+ TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
+ TaskCore.Review -> ("badge badge-review", "Review")
+ TaskCore.Approved -> ("badge badge-approved", "Approved")
+ TaskCore.Done -> ("badge badge-done", "Done")
+ TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
+ in Lucid.span_ [Lucid.class_ cls] label
+
+complexityBadge :: (Monad m) => Int -> Lucid.HtmlT m ()
+complexityBadge complexity =
+ let cls = "badge badge-complexity badge-complexity-" <> tshow complexity
+ label = "ℂ " <> tshow complexity
+ in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] (Lucid.toHtml label)
+
+-- * Sort dropdown
+
+sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
+sortDropdown basePath currentSort =
+ Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
+ Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
+ Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
+ Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
+ <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
+ Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
+ sortOption basePath SortNewest currentSort
+ sortOption basePath SortOldest currentSort
+ sortOption basePath SortUpdated currentSort
+ sortOption basePath SortPriorityHigh currentSort
+ sortOption basePath SortPriorityLow currentSort
+
+sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
+sortOption basePath option currentSort =
+ let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
+ href = basePath <> "?sort=" <> sortOrderToParam option
+ in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
+
+-- * Progress bars
+
+multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
+multiColorProgressBar stats =
+ let total = TaskCore.totalTasks stats
+ doneCount = TaskCore.doneTasks stats
+ inProgressCount = TaskCore.inProgressTasks stats
+ openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
+ donePct = if total == 0 then 0 else (doneCount * 100) `div` total
+ inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
+ openPct = if total == 0 then 0 else (openCount * 100) `div` total
+ in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
+ Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
+ when (donePct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-done",
+ Lucid.style_ ("width: " <> tshow donePct <> "%"),
+ Lucid.title_ (tshow doneCount <> " done")
+ ]
+ ""
+ when (inProgressPct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-inprogress",
+ Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
+ Lucid.title_ (tshow inProgressCount <> " in progress")
+ ]
+ ""
+ when (openPct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-open",
+ Lucid.style_ ("width: " <> tshow openPct <> "%"),
+ Lucid.title_ (tshow openCount <> " open")
+ ]
+ ""
+ Lucid.div_ [Lucid.class_ "progress-legend"] <| do
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
+ Lucid.toHtml ("Done " <> tshow doneCount)
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
+ Lucid.toHtml ("In Progress " <> tshow inProgressCount)
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
+ Lucid.toHtml ("Open " <> tshow openCount)
+
+epicProgressBar :: (Monad m) => Int -> Int -> Int -> Int -> Lucid.HtmlT m ()
+epicProgressBar doneCount inProgressCount openCount totalCount =
+ let donePct = if totalCount == 0 then 0 else (doneCount * 100) `div` totalCount
+ inProgressPct = if totalCount == 0 then 0 else (inProgressCount * 100) `div` totalCount
+ openPct = if totalCount == 0 then 0 else (openCount * 100) `div` totalCount
+ in Lucid.div_ [Lucid.class_ "multi-progress-container epic-progress"] <| do
+ Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
+ when (donePct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-done",
+ Lucid.style_ ("width: " <> tshow donePct <> "%"),
+ Lucid.title_ (tshow doneCount <> " done")
+ ]
+ ""
+ when (inProgressPct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-inprogress",
+ Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
+ Lucid.title_ (tshow inProgressCount <> " in progress")
+ ]
+ ""
+ when (openPct > 0)
+ <| Lucid.div_
+ [ Lucid.class_ "multi-progress-segment progress-open",
+ Lucid.style_ ("width: " <> tshow openPct <> "%"),
+ Lucid.title_ (tshow openCount <> " open")
+ ]
+ ""
+ Lucid.div_ [Lucid.class_ "progress-legend"] <| do
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
+ Lucid.toHtml (tshow doneCount)
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
+ Lucid.toHtml (tshow inProgressCount)
+ Lucid.span_ [Lucid.class_ "legend-item"] <| do
+ Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
+ Lucid.toHtml (tshow openCount)
+
+-- * Status badge with form
+
+statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
+statusBadgeWithForm status tid =
+ Lucid.div_
+ [ Lucid.id_ "status-badge-container",
+ Lucid.class_ "status-badge-dropdown"
+ ]
+ <| do
+ clickableBadge status tid
+ statusDropdownOptions status tid
+
+clickableBadge :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
+clickableBadge status _tid =
+ let (cls, label) = case status of
+ TaskCore.Draft -> ("badge badge-draft status-badge-clickable", "Draft" :: Text)
+ TaskCore.Open -> ("badge badge-open status-badge-clickable", "Open")
+ TaskCore.InProgress -> ("badge badge-inprogress status-badge-clickable", "In Progress")
+ TaskCore.Review -> ("badge badge-review status-badge-clickable", "Review")
+ TaskCore.Approved -> ("badge badge-approved status-badge-clickable", "Approved")
+ TaskCore.Done -> ("badge badge-done status-badge-clickable", "Done")
+ TaskCore.NeedsHelp -> ("badge badge-needshelp status-badge-clickable", "Needs Help")
+ in Lucid.span_
+ [ Lucid.class_ cls,
+ Lucid.tabindex_ "0",
+ Lucid.role_ "button",
+ Lucid.makeAttribute "aria-haspopup" "true",
+ Lucid.makeAttribute "aria-expanded" "false",
+ Lucid.makeAttribute "onclick" "toggleStatusDropdown(this)",
+ Lucid.makeAttribute "onkeydown" "handleStatusKeydown(event, this)"
+ ]
+ <| do
+ Lucid.toHtml label
+ Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
+
+statusDropdownOptions :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
+statusDropdownOptions currentStatus tid =
+ Lucid.div_
+ [ Lucid.class_ "status-dropdown-menu",
+ Lucid.role_ "menu",
+ Lucid.makeAttribute "aria-label" "Change task status"
+ ]
+ <| do
+ statusOption TaskCore.Draft currentStatus tid
+ statusOption TaskCore.Open currentStatus tid
+ statusOption TaskCore.InProgress currentStatus tid
+ statusOption TaskCore.Review currentStatus tid
+ statusOption TaskCore.Approved currentStatus tid
+ statusOption TaskCore.Done currentStatus tid
+ statusOption TaskCore.NeedsHelp currentStatus tid
+
+statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Text -> Lucid.HtmlT m ()
+statusOption opt currentStatus tid =
+ let (cls, label) = case opt of
+ TaskCore.Draft -> ("badge badge-draft", "Draft" :: Text)
+ TaskCore.Open -> ("badge badge-open", "Open")
+ TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
+ TaskCore.Review -> ("badge badge-review", "Review")
+ TaskCore.Approved -> ("badge badge-approved", "Approved")
+ TaskCore.Done -> ("badge badge-done", "Done")
+ TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
+ isSelected = opt == currentStatus
+ optClass = cls <> " status-dropdown-option" <> if isSelected then " selected" else ""
+ in Lucid.form_
+ [ Lucid.class_ "status-option-form",
+ Lucid.role_ "none",
+ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
+ Lucid.makeAttribute "hx-target" "#status-badge-container",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ <| do
+ Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ (tshow opt)]
+ Lucid.button_
+ [ Lucid.type_ "submit",
+ Lucid.class_ optClass,
+ Lucid.role_ "menuitem",
+ Lucid.tabindex_ "-1",
+ Lucid.makeAttribute "onkeydown" "handleMenuItemKeydown(event)"
+ ]
+ (Lucid.toHtml label)
+
+-- * Priority badge with form
+
+priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityBadgeWithForm priority tid =
+ Lucid.div_
+ [ Lucid.id_ "priority-badge-container",
+ Lucid.class_ "priority-badge-dropdown"
+ ]
+ <| do
+ clickablePriorityBadge priority tid
+ priorityDropdownOptions priority tid
+
+clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+clickablePriorityBadge priority _tid =
+ let (cls, label) = case priority of
+ TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
+ TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
+ TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
+ TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
+ TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
+ in Lucid.span_
+ [ Lucid.class_ cls,
+ Lucid.tabindex_ "0",
+ Lucid.role_ "button",
+ Lucid.makeAttribute "aria-haspopup" "true",
+ Lucid.makeAttribute "aria-expanded" "false",
+ Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
+ Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
+ ]
+ <| do
+ Lucid.toHtml label
+ Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
+
+priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityDropdownOptions currentPriority tid =
+ Lucid.div_
+ [ Lucid.class_ "priority-dropdown-menu",
+ Lucid.role_ "menu",
+ Lucid.makeAttribute "aria-label" "Change task priority"
+ ]
+ <| do
+ priorityOption TaskCore.P0 currentPriority tid
+ priorityOption TaskCore.P1 currentPriority tid
+ priorityOption TaskCore.P2 currentPriority tid
+ priorityOption TaskCore.P3 currentPriority tid
+ priorityOption TaskCore.P4 currentPriority tid
+
+priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
+priorityOption opt currentPriority tid =
+ let (cls, label) = case opt of
+ TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
+ TaskCore.P1 -> ("badge badge-p1", "P1 High")
+ TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
+ TaskCore.P3 -> ("badge badge-p3", "P3 Low")
+ TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
+ isSelected = opt == currentPriority
+ optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
+ in Lucid.form_
+ [ Lucid.class_ "priority-option-form",
+ Lucid.role_ "none",
+ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
+ Lucid.makeAttribute "hx-target" "#priority-badge-container",
+ Lucid.makeAttribute "hx-swap" "outerHTML"
+ ]
+ <| do
+ Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
+ Lucid.button_
+ [ Lucid.type_ "submit",
+ Lucid.class_ optClass,
+ Lucid.role_ "menuitem",
+ Lucid.tabindex_ "-1",
+ Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
+ ]
+ (Lucid.toHtml label)
+
+-- * Task rendering
+
+renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
+renderTaskCard t =
+ Lucid.a_
+ [ Lucid.class_ "task-card task-card-link",
+ Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "task-header"] <| do
+ Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
+ statusBadge (TaskCore.taskStatus t)
+ Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
+ Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+
+renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
+renderBlockedTaskCard (t, impact) =
+ Lucid.a_
+ [ Lucid.class_ "task-card task-card-link",
+ Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "task-header"] <| do
+ Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
+ statusBadge (TaskCore.taskStatus t)
+ Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
+ when (impact > 0)
+ <| Lucid.span_ [Lucid.class_ "blocking-impact"] (Lucid.toHtml ("Blocks " <> tshow impact))
+ Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+
+renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
+renderListGroupItem t =
+ Lucid.a_
+ [ Lucid.class_ "list-group-item",
+ Lucid.href_ ("/tasks/" <> TaskCore.taskId t),
+ Lucid.makeAttribute "hx-boost" "true",
+ Lucid.makeAttribute "hx-target" "body",
+ Lucid.makeAttribute "hx-swap" "innerHTML"
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "list-group-item-content"] <| do
+ Lucid.span_ [Lucid.class_ "list-group-item-id"] (Lucid.toHtml (TaskCore.taskId t))
+ Lucid.span_ [Lucid.class_ "list-group-item-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+ Lucid.div_ [Lucid.class_ "list-group-item-meta"] <| do
+ statusBadge (TaskCore.taskStatus t)
+ Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
+
+renderEpicReviewCard :: (Monad m) => TaskCore.EpicForReview -> Lucid.HtmlT m ()
+renderEpicReviewCard epicReview = do
+ let task = TaskCore.epicTask epicReview
+ total = TaskCore.epicTotal epicReview
+ completed = TaskCore.epicCompleted epicReview
+ progressText = tshow completed <> "/" <> tshow total <> " subtasks done"
+ Lucid.div_ [Lucid.class_ "task-card"] <| do
+ Lucid.div_ [Lucid.class_ "task-card-header"] <| do
+ Lucid.div_ [Lucid.class_ "task-title-row"] <| do
+ Lucid.a_
+ [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
+ <| Lucid.toHtml (TaskCore.taskTitle task)
+ Lucid.span_ [Lucid.class_ "badge badge-epic"] "Epic"
+ Lucid.span_ [Lucid.class_ "task-id"] <| Lucid.toHtml (TaskCore.taskId task)
+ Lucid.div_ [Lucid.class_ "task-card-body"] <| do
+ Lucid.div_ [Lucid.class_ "progress-info"] <| do
+ Lucid.span_ [Lucid.class_ "badge badge-success"] <| Lucid.toHtml progressText
+ Lucid.div_ [Lucid.class_ "epic-actions"] <| do
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
+ Lucid.class_ "inline-form"
+ ]
+ <| do
+ Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ "done"]
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-success btn-sm"] "Approve & Close"
+
+renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m ()
+renderEpicCardWithStats allTasks t =
+ let children = getDescendants allTasks (TaskCore.taskId t)
+ openCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Open]
+ inProgressCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.InProgress]
+ reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review]
+ doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done]
+ totalCount = length children
+ openAndReview = openCount + reviewCount
+ in Lucid.a_
+ [ Lucid.class_ "task-card task-card-link",
+ Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "task-header"] <| do
+ Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
+ statusBadge (TaskCore.taskStatus t)
+ Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
+ Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
+ when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount
+ unless (Text.null (TaskCore.taskDescription t))
+ <| Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 (TaskCore.taskDescription t) <> "..."))
+
+getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task]
+getDescendants allTasks parentId =
+ let children = [c | c <- allTasks, maybe False (TaskCore.matchesId parentId) (TaskCore.taskParent c)]
+ in children ++ concatMap (getDescendants allTasks <. TaskCore.taskId) children
+
+-- * Aggregated metrics
+
+renderAggregatedMetrics :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> TaskCore.AggregatedMetrics -> Lucid.HtmlT m ()
+renderAggregatedMetrics allTasks task metrics =
+ let descendants = getDescendants allTasks (TaskCore.taskId task)
+ totalCount = length descendants
+ costCents = TaskCore.aggTotalCostCents metrics
+ durationSecs = TaskCore.aggTotalDurationSeconds metrics
+ completedCount = TaskCore.aggCompletedTasks metrics
+ tokensUsed = TaskCore.aggTotalTokens metrics
+ in Lucid.div_ [Lucid.class_ "detail-section aggregated-metrics"] <| do
+ Lucid.h3_ "Execution Summary"
+ Lucid.div_ [Lucid.class_ "metrics-grid"] <| do
+ Lucid.div_ [Lucid.class_ "metric-card"] <| do
+ Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow completedCount <> "/" <> tshow totalCount))
+ Lucid.div_ [Lucid.class_ "metric-label"] "Tasks Completed"
+ Lucid.div_ [Lucid.class_ "metric-card"] <| do
+ Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostMetric costCents))
+ Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost"
+ Lucid.div_ [Lucid.class_ "metric-card"] <| do
+ Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurationMetric durationSecs))
+ Lucid.div_ [Lucid.class_ "metric-label"] "Total Time"
+ when (tokensUsed > 0) <| do
+ Lucid.div_ [Lucid.class_ "metric-card"] <| do
+ Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTokensMetric tokensUsed))
+ Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used"
+ where
+ formatCostMetric :: Int -> Text
+ formatCostMetric cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
+ formatDurationMetric :: Int -> Text
+ formatDurationMetric secs
+ | secs < 60 = tshow secs <> "s"
+ | secs < 3600 =
+ let mins = secs `div` 60
+ remSecs = secs `mod` 60
+ in tshow mins <> "m " <> tshow remSecs <> "s"
+ | otherwise =
+ let hrs = secs `div` 3600
+ mins = (secs `mod` 3600) `div` 60
+ in tshow hrs <> "h " <> tshow mins <> "m"
+
+ formatTokensMetric :: Int -> Text
+ formatTokensMetric t
+ | t < 1000 = tshow t
+ | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
+ | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
+
+-- * Retry context banner
+
+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
+ 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 <| 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.p_ [Lucid.class_ "retry-hint"] "Use comments below to provide guidance for retry."
+
+ Lucid.div_ [Lucid.class_ "retry-reset-section"] <| do
+ Lucid.h4_ "Reset Retries"
+ Lucid.p_ [Lucid.class_ "notes-help"] "Clear retry context and give task a fresh start:"
+ Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reset-btn"] "Reset Retries"
+ 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 ""
+
+-- * Markdown rendering
+
+renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderMarkdown input = renderBlocks (parseBlocks (Text.lines input))
+
+data MarkdownBlock
+ = MdHeader Int Text
+ | MdParagraph [Text]
+ | MdCodeBlock [Text]
+ | MdList [Text]
+ deriving (Show, Eq)
+
+parseBlocks :: [Text] -> [MarkdownBlock]
+parseBlocks [] = []
+parseBlocks lns = case lns of
+ (l : rest)
+ | "```" `Text.isPrefixOf` l ->
+ let (codeLines, afterCode) = List.span (not <. Text.isPrefixOf "```") rest
+ remaining = List.drop 1 afterCode
+ in MdCodeBlock codeLines : parseBlocks remaining
+ | "### " `Text.isPrefixOf` l ->
+ MdHeader 3 (Text.drop 4 l) : parseBlocks rest
+ | "## " `Text.isPrefixOf` l ->
+ MdHeader 2 (Text.drop 3 l) : parseBlocks rest
+ | "# " `Text.isPrefixOf` l ->
+ MdHeader 1 (Text.drop 2 l) : parseBlocks rest
+ | isListItem l ->
+ let (listLines, afterList) = List.span isListItem lns
+ in MdList (map stripListPrefix listLines) : parseBlocks afterList
+ | Text.null (Text.strip l) ->
+ parseBlocks rest
+ | otherwise ->
+ let (paraLines, afterPara) = List.span isParagraphLine lns
+ in MdParagraph paraLines : parseBlocks afterPara
+ where
+ isListItem t =
+ let stripped = Text.stripStart t
+ in "- " `Text.isPrefixOf` stripped || "* " `Text.isPrefixOf` stripped
+ stripListPrefix t =
+ let stripped = Text.stripStart t
+ in Text.drop 2 stripped
+ isParagraphLine t =
+ not (Text.null (Text.strip t))
+ && not ("```" `Text.isPrefixOf` t)
+ && not ("#" `Text.isPrefixOf` t)
+ && not (isListItem t)
+
+renderBlocks :: (Monad m) => [MarkdownBlock] -> Lucid.HtmlT m ()
+renderBlocks = traverse_ renderBlock
+
+renderBlock :: (Monad m) => MarkdownBlock -> Lucid.HtmlT m ()
+renderBlock block = case block of
+ MdHeader 1 txt -> Lucid.h2_ [Lucid.class_ "md-h1"] (renderInline txt)
+ MdHeader 2 txt -> Lucid.h3_ [Lucid.class_ "md-h2"] (renderInline txt)
+ MdHeader 3 txt -> Lucid.h4_ [Lucid.class_ "md-h3"] (renderInline txt)
+ MdHeader _ txt -> Lucid.h4_ (renderInline txt)
+ MdParagraph lns -> Lucid.p_ [Lucid.class_ "md-para"] (renderInline (Text.unlines lns))
+ MdCodeBlock lns -> Lucid.pre_ [Lucid.class_ "md-code"] (Lucid.code_ (Lucid.toHtml (Text.unlines lns)))
+ MdList items -> Lucid.ul_ [Lucid.class_ "md-list"] (traverse_ renderListItem items)
+
+renderListItem :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderListItem txt = Lucid.li_ (renderInline txt)
+
+renderInline :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderInline txt = renderInlineParts (parseInline txt)
+
+data InlinePart = PlainText Text | InlineCode Text | BoldText Text
+ deriving (Show, Eq)
+
+parseInline :: Text -> [InlinePart]
+parseInline t
+ | Text.null t = []
+ | otherwise = case Text.breakOn "`" t of
+ (before, rest)
+ | Text.null rest -> parseBold before
+ | otherwise ->
+ let afterTick = Text.drop 1 rest
+ in case Text.breakOn "`" afterTick of
+ (code, rest2)
+ | Text.null rest2 ->
+ parseBold before ++ [PlainText ("`" <> afterTick)]
+ | otherwise ->
+ parseBold before ++ [InlineCode code] ++ parseInline (Text.drop 1 rest2)
+
+parseBold :: Text -> [InlinePart]
+parseBold t
+ | Text.null t = []
+ | otherwise = case Text.breakOn "**" t of
+ (before, rest)
+ | Text.null rest -> [PlainText before | not (Text.null before)]
+ | otherwise ->
+ let afterBold = Text.drop 2 rest
+ in case Text.breakOn "**" afterBold of
+ (boldText, rest2)
+ | Text.null rest2 ->
+ [PlainText before | not (Text.null before)] ++ [PlainText ("**" <> afterBold)]
+ | otherwise ->
+ [PlainText before | not (Text.null before)]
+ ++ [BoldText boldText]
+ ++ parseBold (Text.drop 2 rest2)
+
+renderInlineParts :: (Monad m) => [InlinePart] -> Lucid.HtmlT m ()
+renderInlineParts = traverse_ renderInlinePart
+
+renderInlinePart :: (Monad m) => InlinePart -> Lucid.HtmlT m ()
+renderInlinePart part = case part of
+ PlainText txt -> Lucid.toHtml txt
+ InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt)
+ BoldText txt -> Lucid.strong_ (Lucid.toHtml txt)
+
+-- * Comment form
+
+commentForm :: (Monad m) => Text -> Lucid.HtmlT m ()
+commentForm tid =
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> tid <> "/comment"),
+ Lucid.class_ "comment-form"
+ ]
+ <| do
+ Lucid.textarea_
+ [ Lucid.name_ "comment",
+ Lucid.placeholder_ "Add a comment...",
+ Lucid.rows_ "3",
+ Lucid.class_ "comment-textarea"
+ ]
+ ""
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Post Comment"
+
+-- * Live toggles
+
+renderLiveToggle :: (Monad m) => Lucid.HtmlT m ()
+renderLiveToggle =
+ Lucid.button_
+ [ Lucid.class_ "timeline-live-toggle",
+ Lucid.id_ "live-toggle",
+ Lucid.makeAttribute "onclick" "toggleLiveUpdates()",
+ Lucid.title_ "Click to pause/resume live updates"
+ ]
+ " LIVE"
+
+renderAutoscrollToggle :: (Monad m) => Lucid.HtmlT m ()
+renderAutoscrollToggle =
+ Lucid.button_
+ [ Lucid.class_ "timeline-autoscroll-toggle",
+ Lucid.id_ "autoscroll-toggle",
+ Lucid.makeAttribute "onclick" "toggleAutoscroll()",
+ Lucid.title_ "Toggle automatic scrolling to newest events"
+ ]
+ " ⬇ Auto-scroll"
+
+-- * Cost/Token metrics
+
+aggregateCostMetrics :: [TaskCore.StoredEvent] -> (Int, Int)
+aggregateCostMetrics events =
+ let costEvents = filter (\e -> TaskCore.storedEventType e == "Cost") events
+ aggregateOne (totalCents, totalTokens) event =
+ case Aeson.decode (LBS.fromStrict (str (TaskCore.storedEventContent event))) of
+ Just (Aeson.Object obj) ->
+ let cents = case KeyMap.lookup "cents" obj of
+ Just (Aeson.Number n) -> floor n
+ _ -> 0
+ tokens = case KeyMap.lookup "tokens" obj of
+ Just (Aeson.Number n) -> floor n
+ _ -> 0
+ in (totalCents + cents, totalTokens + tokens)
+ _ -> (totalCents, totalTokens)
+ in foldl' aggregateOne (0, 0) costEvents
+
+formatCostHeader :: Int -> Text
+formatCostHeader cents =
+ let dollars = fromIntegral cents / 100.0 :: Double
+ in "$" <> Text.pack (showFFloat (Just 2) dollars "")
+
+formatTokensHeader :: Int -> Text
+formatTokensHeader t
+ | t < 1000 = tshow t
+ | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
+ | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
+
+-- * Timeline
+
+renderUnifiedTimeline :: (Monad m) => Text -> [TaskCore.Comment] -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
+renderUnifiedTimeline tid legacyComments events status now = do
+ let isInProgress = status == TaskCore.InProgress
+ pollAttrs =
+ if isInProgress
+ then
+ [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> tid <> "/events"),
+ Lucid.makeAttribute "hx-trigger" "every 3s",
+ Lucid.makeAttribute "hx-swap" "innerHTML",
+ Lucid.makeAttribute "hx-on::before-request" "var log = this.querySelector('.timeline-events'); if(log) this.dataset.scroll = log.scrollTop",
+ Lucid.makeAttribute "hx-on::after-swap" "var log = this.querySelector('.timeline-events'); if(log && this.dataset.scroll) log.scrollTop = this.dataset.scroll"
+ ]
+ else []
+ nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
+ eventCount = length nonCostEvents + length legacyComments
+ (totalCents, totalTokens) = aggregateCostMetrics events
+ Lucid.div_ ([Lucid.class_ "unified-timeline-section", Lucid.id_ "unified-timeline"] <> pollAttrs) <| do
+ 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 && null legacyComments
+ 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
+
+renderTimelineEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
+renderTimelineEvent now event =
+ let eventType = TaskCore.storedEventType event
+ content = TaskCore.storedEventContent event
+ timestamp = TaskCore.storedEventTimestamp event
+ actor = TaskCore.storedEventActor event
+ eventId = TaskCore.storedEventId event
+ (icon, label) = eventTypeIconAndLabel eventType
+ in Lucid.div_
+ [ Lucid.class_ ("timeline-event timeline-event-" <> eventType),
+ Lucid.makeAttribute "data-event-id" (tshow eventId)
+ ]
+ <| do
+ case eventType of
+ "comment" -> renderCommentTimelineEvent content actor timestamp now
+ "status_change" -> renderStatusChangeEvent content actor timestamp now
+ "claim" -> renderActivityEvent icon label content actor timestamp now
+ "running" -> renderActivityEvent icon label content actor timestamp now
+ "reviewing" -> renderActivityEvent icon label content actor timestamp now
+ "retrying" -> renderActivityEvent icon label content actor timestamp now
+ "complete" -> renderActivityEvent icon label content actor timestamp now
+ "error" -> renderErrorTimelineEvent content actor timestamp now
+ "Assistant" -> renderAssistantTimelineEvent content actor timestamp now
+ "ToolCall" -> renderToolCallTimelineEvent content actor timestamp now
+ "ToolResult" -> renderToolResultTimelineEvent content actor timestamp now
+ "Cost" -> pure ()
+ "Checkpoint" -> renderCheckpointEvent content actor timestamp now
+ "Guardrail" -> renderGuardrailEvent content actor timestamp now
+ _ -> renderGenericEvent eventType content actor timestamp now
+
+eventTypeIconAndLabel :: Text -> (Text, Text)
+eventTypeIconAndLabel "comment" = ("💬", "Comment")
+eventTypeIconAndLabel "status_change" = ("🔄", "Status")
+eventTypeIconAndLabel "claim" = ("🤖", "Claimed")
+eventTypeIconAndLabel "running" = ("▶️", "Running")
+eventTypeIconAndLabel "reviewing" = ("👀", "Reviewing")
+eventTypeIconAndLabel "retrying" = ("🔁", "Retrying")
+eventTypeIconAndLabel "complete" = ("✅", "Complete")
+eventTypeIconAndLabel "error" = ("❌", "Error")
+eventTypeIconAndLabel "Assistant" = ("💭", "Thought")
+eventTypeIconAndLabel "ToolCall" = ("🔧", "Tool")
+eventTypeIconAndLabel "ToolResult" = ("📄", "Result")
+eventTypeIconAndLabel "Cost" = ("💰", "Cost")
+eventTypeIconAndLabel "Checkpoint" = ("📍", "Checkpoint")
+eventTypeIconAndLabel "Guardrail" = ("⚠️", "Guardrail")
+eventTypeIconAndLabel t = ("📝", t)
+
+renderActorLabel :: (Monad m) => TaskCore.CommentAuthor -> Lucid.HtmlT m ()
+renderActorLabel actor =
+ let (cls, label) :: (Text, Text) = case actor of
+ TaskCore.Human -> ("actor-human", "human")
+ TaskCore.Junior -> ("actor-junior", "junior")
+ TaskCore.System -> ("actor-system", "system")
+ in Lucid.span_ [Lucid.class_ ("actor-label " <> cls)] (Lucid.toHtml ("[" <> label <> "]"))
+
+renderCommentTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderCommentTimelineEvent content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-comment"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "💬"
+ renderActorLabel actor
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content comment-bubble markdown-content"] <| do
+ renderMarkdown content
+
+renderStatusChangeEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderStatusChangeEvent content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-status-change"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "🔄"
+ renderActorLabel actor
+ Lucid.span_ [Lucid.class_ "status-change-text"] (Lucid.toHtml (parseStatusChange content))
+ renderRelativeTimestamp now timestamp
+
+parseStatusChange :: Text -> Text
+parseStatusChange content =
+ case Aeson.decode (LBS.fromStrict (str content)) of
+ Just (Aeson.Object obj) ->
+ let fromStatus = case KeyMap.lookup "from" obj of
+ Just (Aeson.String s) -> s
+ _ -> "?"
+ toStatus = case KeyMap.lookup "to" obj of
+ Just (Aeson.String s) -> s
+ _ -> "?"
+ in fromStatus <> " → " <> toStatus
+ _ -> content
+
+renderActivityEvent :: (Monad m) => Text -> Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderActivityEvent icon label content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-activity"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] (Lucid.toHtml icon)
+ Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml label)
+ renderActorLabel actor
+ unless (Text.null content) <| Lucid.span_ [Lucid.class_ "activity-detail"] (Lucid.toHtml content)
+ renderRelativeTimestamp now timestamp
+
+renderErrorTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderErrorTimelineEvent content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-error"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "❌"
+ Lucid.span_ [Lucid.class_ "event-label"] "Error"
+ renderActorLabel actor
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content error-message"] (Lucid.toHtml content)
+
+renderAssistantTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderAssistantTimelineEvent content _actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-thought"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "💭"
+ Lucid.span_ [Lucid.class_ "event-label"] "Thought"
+ renderActorLabel TaskCore.Junior
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content thought-bubble markdown-content"] <| do
+ let truncated = Text.take 2000 content
+ isTruncated = Text.length content > 2000
+ renderMarkdown truncated
+ when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
+
+renderToolCallTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderToolCallTimelineEvent content _actor timestamp now =
+ let (toolName, args) = parseToolCallContent content
+ summary = formatToolCallSummary toolName args
+ in Lucid.details_ [Lucid.class_ "timeline-tool-call"] <| do
+ Lucid.summary_ <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "🔧"
+ Lucid.span_ [Lucid.class_ "tool-name"] (Lucid.toHtml toolName)
+ Lucid.span_ [Lucid.class_ "tool-summary"] (Lucid.toHtml summary)
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content tool-args"] <| do
+ renderCollapsibleOutput args
+
+renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderToolResultTimelineEvent content _actor timestamp now =
+ let lineCount = length (Text.lines content)
+ in Lucid.details_ [Lucid.class_ "timeline-tool-result"] <| do
+ Lucid.summary_ <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "📄"
+ Lucid.span_ [Lucid.class_ "event-label"] "Result"
+ when (lineCount > 1)
+ <| Lucid.span_ [Lucid.class_ "line-count"] (Lucid.toHtml (tshow lineCount <> " lines"))
+ renderRelativeTimestamp now timestamp
+ Lucid.pre_ [Lucid.class_ "event-content tool-output"] (renderDecodedToolResult content)
+
+renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderCheckpointEvent content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-checkpoint"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "📍"
+ Lucid.span_ [Lucid.class_ "event-label"] "Checkpoint"
+ renderActorLabel actor
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content checkpoint-content"] (Lucid.toHtml content)
+
+renderGuardrailEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderGuardrailEvent content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-guardrail"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "⚠️"
+ Lucid.span_ [Lucid.class_ "event-label"] "Guardrail"
+ renderActorLabel actor
+ renderRelativeTimestamp now timestamp
+ Lucid.div_ [Lucid.class_ "event-content guardrail-content"] (Lucid.toHtml content)
+
+renderGenericEvent :: (Monad m) => Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
+renderGenericEvent eventType content actor timestamp now =
+ Lucid.div_ [Lucid.class_ "timeline-generic"] <| do
+ Lucid.div_ [Lucid.class_ "event-header"] <| do
+ Lucid.span_ [Lucid.class_ "event-icon"] "📝"
+ Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml eventType)
+ renderActorLabel actor
+ renderRelativeTimestamp now timestamp
+ unless (Text.null content) <| Lucid.div_ [Lucid.class_ "event-content"] (Lucid.toHtml content)
+
+parseToolCallContent :: Text -> (Text, Text)
+parseToolCallContent content =
+ case Text.breakOn ":" content of
+ (name, rest)
+ | Text.null rest -> (content, "")
+ | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))
+
+formatToolCallSummary :: Text -> Text -> Text
+formatToolCallSummary toolName argsJson =
+ case Aeson.decode (LBS.fromStrict (str argsJson)) of
+ Just (Aeson.Object obj) ->
+ let keyArg = case toolName of
+ "run_bash" -> KeyMap.lookup "command" obj
+ "read_file" -> KeyMap.lookup "path" obj
+ "edit_file" -> KeyMap.lookup "path" obj
+ "write_file" -> KeyMap.lookup "path" obj
+ "search_codebase" -> KeyMap.lookup "pattern" obj
+ "glob_files" -> KeyMap.lookup "pattern" obj
+ "list_directory" -> KeyMap.lookup "path" obj
+ _ -> Nothing
+ in case keyArg of
+ Just (Aeson.String s) -> "`" <> Text.take 100 s <> "`"
+ _ -> Text.take 80 argsJson
+ _ -> Text.take 80 argsJson
+
+renderCollapsibleOutput :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderCollapsibleOutput content =
+ let lineCount = length (Text.lines content)
+ in if lineCount > 20
+ then
+ Lucid.details_ [Lucid.class_ "output-collapsible"] <| do
+ Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
+ Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
+ else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
+
+renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
+renderDecodedToolResult content =
+ case Aeson.decode (LBS.fromStrict (str content)) of
+ Just (Aeson.Object obj) ->
+ case KeyMap.lookup "output" obj of
+ Just (Aeson.String output) -> Lucid.toHtml output
+ _ -> Lucid.toHtml content
+ _ -> Lucid.toHtml content
+
+timelineScrollScript :: (Monad m) => Lucid.HtmlT m ()
+timelineScrollScript =
+ Lucid.script_
+ [ Lucid.type_ "text/javascript"
+ ]
+ ( Text.unlines
+ [ "(function() {",
+ " var log = document.querySelector('.timeline-events');",
+ " if (log) {",
+ " var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",
+ " if (isNearBottom) {",
+ " log.scrollTop = log.scrollHeight;",
+ " }",
+ " }",
+ "})();"
+ ]
+ )
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-19 06:38:29 +0000