{-# 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, complexityDropdownJs, liveToggleJs, -- * Breadcrumbs Breadcrumb (..), Breadcrumbs, renderBreadcrumbs, getAncestors, taskBreadcrumbs, -- * Badges statusBadge, complexityBadge, statusBadgeWithForm, clickableBadge, statusDropdownOptions, statusOption, priorityBadgeWithForm, clickablePriorityBadge, priorityDropdownOptions, priorityOption, complexityBadgeWithForm, clickableComplexityBadge, complexityDropdownOptions, complexityOption, -- * Sorting 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, renderFormattedJson, timelineScrollScript, -- * Tool rendering helpers renderBashToolCall, renderReadToolCall, renderEditToolCall, renderSearchToolCall, renderSearchAndReadToolCall, renderWriteToolCall, renderGenericToolCall, extractJsonField, extractJsonFieldInt, shortenPath, DecodedToolResult (..), decodeToolResult, ) where import Alpha import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as AesonKey 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 Omni.Jr.Web.Types (SortOrder (..), sortOrderLabel, sortOrderToParam) 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"] "·" -- * 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_ [] complexityDropdownJs 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);", " }", " });", "});" ] complexityDropdownJs :: Text complexityDropdownJs = Text.unlines [ "function toggleComplexityDropdown(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 closeComplexityDropdown(container) {", " container.classList.remove('open');", " var badge = container.querySelector('[role=\"button\"]');", " if (badge) {", " badge.setAttribute('aria-expanded', 'false');", " badge.focus();", " }", "}", "", "function handleComplexityKeydown(event, el) {", " if (event.key === 'Enter' || event.key === ' ') {", " event.preventDefault();", " toggleComplexityDropdown(el);", " } else if (event.key === 'Escape') {", " closeComplexityDropdown(el.parentElement);", " } else if (event.key === 'ArrowDown') {", " event.preventDefault();", " var container = el.parentElement;", " if (!container.classList.contains('open')) {", " toggleComplexityDropdown(el);", " } else {", " var firstItem = container.querySelector('[role=\"menuitem\"]');", " if (firstItem) firstItem.focus();", " }", " }", "}", "", "function handleComplexityMenuItemKeydown(event) {", " var container = event.target.closest('.complexity-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();", " closeComplexityDropdown(container);", " } else if (event.key === 'Tab') {", " closeComplexityDropdown(container);", " }", "}", "", "document.addEventListener('click', function(e) {", " var dropdowns = document.querySelectorAll('.complexity-badge-dropdown.open');", " dropdowns.forEach(function(d) {", " if (!d.contains(e.target)) {", " closeComplexityDropdown(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) -- * Complexity badge with form complexityBadgeWithForm :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m () complexityBadgeWithForm complexity tid = Lucid.div_ [ Lucid.id_ "complexity-badge-container", Lucid.class_ "complexity-badge-dropdown" ] <| do clickableComplexityBadge complexity tid complexityDropdownOptions complexity tid clickableComplexityBadge :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m () clickableComplexityBadge complexity _tid = let (cls, label) = case complexity of Nothing -> ("badge badge-complexity-none complexity-badge-clickable", "Set Complexity" :: Text) Just 1 -> ("badge badge-complexity-1 complexity-badge-clickable", "ℂ 1") Just 2 -> ("badge badge-complexity-2 complexity-badge-clickable", "ℂ 2") Just 3 -> ("badge badge-complexity-3 complexity-badge-clickable", "ℂ 3") Just 4 -> ("badge badge-complexity-4 complexity-badge-clickable", "ℂ 4") Just 5 -> ("badge badge-complexity-5 complexity-badge-clickable", "ℂ 5") Just _ -> ("badge badge-complexity-none complexity-badge-clickable", "Invalid") 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" "toggleComplexityDropdown(this)", Lucid.makeAttribute "onkeydown" "handleComplexityKeydown(event, this)" ] <| do Lucid.toHtml label Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾" complexityDropdownOptions :: (Monad m) => Maybe Int -> Text -> Lucid.HtmlT m () complexityDropdownOptions currentComplexity tid = Lucid.div_ [ Lucid.class_ "complexity-dropdown-menu", Lucid.role_ "menu", Lucid.makeAttribute "aria-label" "Change task complexity" ] <| do complexityOption Nothing currentComplexity tid complexityOption (Just 1) currentComplexity tid complexityOption (Just 2) currentComplexity tid complexityOption (Just 3) currentComplexity tid complexityOption (Just 4) currentComplexity tid complexityOption (Just 5) currentComplexity tid complexityOption :: (Monad m) => Maybe Int -> Maybe Int -> Text -> Lucid.HtmlT m () complexityOption opt currentComplexity tid = let (cls, label, val) = case opt of Nothing -> ("badge badge-complexity-none", "None" :: Text, "none" :: Text) Just 1 -> ("badge badge-complexity-1", "ℂ 1", "1") Just 2 -> ("badge badge-complexity-2", "ℂ 2", "2") Just 3 -> ("badge badge-complexity-3", "ℂ 3", "3") Just 4 -> ("badge badge-complexity-4", "ℂ 4", "4") Just 5 -> ("badge badge-complexity-5", "ℂ 5", "5") Just _ -> ("badge badge-complexity-none", "Invalid", "none") isSelected = opt == currentComplexity optClass = cls <> " complexity-dropdown-option" <> if isSelected then " selected" else "" in Lucid.form_ [ Lucid.class_ "complexity-option-form", Lucid.role_ "none", Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/complexity"), Lucid.makeAttribute "hx-target" "#complexity-badge-container", Lucid.makeAttribute "hx-swap" "outerHTML" ] <| do Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "complexity", Lucid.value_ val] Lucid.button_ [ Lucid.type_ "submit", Lucid.class_ optClass, Lucid.role_ "menuitem", Lucid.tabindex_ "-1", Lucid.makeAttribute "onkeydown" "handleComplexityMenuItemKeydown(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"] (renderFormattedJson 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, argsJson) = parseToolCallContent content in case toolName of "run_bash" -> renderBashToolCall argsJson "read_file" -> renderReadToolCall argsJson "edit_file" -> renderEditToolCall argsJson "search_codebase" -> renderSearchToolCall argsJson "search_and_read" -> renderSearchAndReadToolCall argsJson "write_file" -> renderWriteToolCall argsJson _ -> renderGenericToolCall toolName argsJson renderBashToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderBashToolCall argsJson = let cmd = extractJsonField "command" argsJson in Lucid.div_ [Lucid.class_ "tool-bash"] <| do Lucid.span_ [Lucid.class_ "tool-bash-prompt"] "ϟ" Lucid.code_ [Lucid.class_ "tool-bash-cmd"] (Lucid.toHtml cmd) renderReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderReadToolCall argsJson = let path = extractJsonField "path" argsJson startLine = extractJsonFieldInt "start_line" argsJson endLine = extractJsonFieldInt "end_line" argsJson lineRange = case (startLine, endLine) of (Just s, Just e) -> " @" <> tshow s <> "-" <> tshow e (Just s, Nothing) -> " @" <> tshow s <> "+" _ -> "" in Lucid.div_ [Lucid.class_ "tool-compact"] <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] "Read" Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path <> lineRange)) renderEditToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderEditToolCall argsJson = let path = extractJsonField "path" argsJson in Lucid.div_ [Lucid.class_ "tool-compact"] <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] "Edit" Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path)) renderSearchToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderSearchToolCall argsJson = let searchPat = extractJsonField "pattern" argsJson searchPath = extractJsonField "path" argsJson pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath in Lucid.div_ [Lucid.class_ "tool-compact"] <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] "Grep" Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat) unless (Text.null pathSuffix) <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix) renderWriteToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderWriteToolCall argsJson = let path = extractJsonField "path" argsJson in Lucid.div_ [Lucid.class_ "tool-compact"] <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] "Write" Lucid.code_ [Lucid.class_ "tool-path"] (Lucid.toHtml (shortenPath path)) renderSearchAndReadToolCall :: (Monad m) => Text -> Lucid.HtmlT m () renderSearchAndReadToolCall argsJson = let searchPat = extractJsonField "pattern" argsJson searchPath = extractJsonField "path" argsJson pathSuffix = if Text.null searchPath || searchPath == "." then "" else " in " <> shortenPath searchPath in Lucid.div_ [Lucid.class_ "tool-compact"] <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] "Find" Lucid.code_ [Lucid.class_ "tool-pattern"] (Lucid.toHtml searchPat) unless (Text.null pathSuffix) <| Lucid.span_ [Lucid.class_ "tool-path-suffix"] (Lucid.toHtml pathSuffix) renderGenericToolCall :: (Monad m) => Text -> Text -> Lucid.HtmlT m () renderGenericToolCall toolName argsJson = Lucid.details_ [Lucid.class_ "tool-generic"] <| do Lucid.summary_ <| do Lucid.span_ [Lucid.class_ "tool-check"] "✓" Lucid.span_ [Lucid.class_ "tool-label"] (Lucid.toHtml toolName) Lucid.pre_ [Lucid.class_ "tool-args-pre"] (Lucid.toHtml argsJson) extractJsonField :: Text -> Text -> Text extractJsonField field jsonText = case Aeson.decode (LBS.fromStrict (str jsonText)) of Just (Aeson.Object obj) -> case KeyMap.lookup (AesonKey.fromText field) obj of Just (Aeson.String s) -> s _ -> "" _ -> "" extractJsonFieldInt :: Text -> Text -> Maybe Int extractJsonFieldInt field jsonText = case Aeson.decode (LBS.fromStrict (str jsonText)) of Just (Aeson.Object obj) -> case KeyMap.lookup (AesonKey.fromText field) obj of Just (Aeson.Number n) -> Just (floor n) _ -> Nothing _ -> Nothing shortenPath :: Text -> Text shortenPath path = let parts = Text.splitOn "/" path relevant = dropWhile (\p -> p `elem` ["", "home", "ben", "omni"]) parts in Text.intercalate "/" relevant renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m () renderToolResultTimelineEvent content _actor _timestamp _now = let decoded = decodeToolResult content isSuccess = toolResultIsSuccess decoded output = toolResultOutput' decoded lineCount = length (Text.lines output) in if Text.null output || (isSuccess && lineCount <= 1) then pure () else Lucid.div_ [Lucid.class_ "tool-result-output"] <| do when (lineCount > 10) <| Lucid.details_ [Lucid.class_ "result-collapsible"] <| do Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines")) Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output) when (lineCount <= 10) <| Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml output) data DecodedToolResult = DecodedToolResult { toolResultIsSuccess :: Bool, toolResultOutput' :: Text, toolResultError' :: Maybe Text } decodeToolResult :: Text -> DecodedToolResult decodeToolResult content = case Aeson.decode (LBS.fromStrict (str content)) of Just (Aeson.Object obj) -> DecodedToolResult { toolResultIsSuccess = case KeyMap.lookup "success" obj of Just (Aeson.Bool b) -> b _ -> True, toolResultOutput' = case KeyMap.lookup "output" obj of Just (Aeson.String s) -> s _ -> "", toolResultError' = case KeyMap.lookup "error" obj of Just (Aeson.String s) -> Just s _ -> Nothing } _ -> DecodedToolResult True content Nothing 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"] (renderFormattedJson 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 -- | Format JSON content for human-readable display. -- Tries to pretty-print JSON, falls back to raw text if not valid JSON. renderFormattedJson :: (Monad m) => Text -> Lucid.HtmlT m () renderFormattedJson content = case Aeson.decode (LBS.fromStrict (str content)) of Just (val :: Aeson.Value) -> Lucid.pre_ [Lucid.class_ "formatted-json"] <| do Lucid.toHtml (decodeUtf8 (LBS.toStrict (Aeson.encode val))) Nothing -> Lucid.toHtml content timelineScrollScript :: (Monad m) => Lucid.HtmlT m () timelineScrollScript = Lucid.script_ [ Lucid.type_ "text/javascript" ] ( Text.unlines [ "(function() {", " function scrollToBottom() {", " if (typeof autoscrollEnabled !== 'undefined' && !autoscrollEnabled) return;", " var log = document.querySelector('.timeline-events');", " if (log) {", " var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;", " if (isNearBottom) {", " log.scrollTop = log.scrollHeight;", " }", " }", " }", " scrollToBottom();", " document.body.addEventListener('htmx:afterSwap', function(e) {", " if (e.target.closest('.timeline-events') || e.target.classList.contains('timeline-events')) {", " scrollToBottom();", " }", " });", "})();" ] )