diff options
Diffstat (limited to 'Omni/Jr/Web')
| -rw-r--r-- | Omni/Jr/Web/Components.hs | 1751 | ||||
| -rw-r--r-- | Omni/Jr/Web/Handlers.hs | 649 | ||||
| -rw-r--r-- | Omni/Jr/Web/Pages.hs | 862 | ||||
| -rw-r--r-- | Omni/Jr/Web/Partials.hs | 274 | ||||
| -rw-r--r-- | Omni/Jr/Web/Style.hs | 2260 | ||||
| -rw-r--r-- | Omni/Jr/Web/Types.hs | 365 |
6 files changed, 6161 insertions, 0 deletions
diff --git a/Omni/Jr/Web/Components.hs b/Omni/Jr/Web/Components.hs new file mode 100644 index 0000000..ac36131 --- /dev/null +++ b/Omni/Jr/Web/Components.hs @@ -0,0 +1,1751 @@ +{-# 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();", + " }", + " });", + "})();" + ] + ) diff --git a/Omni/Jr/Web/Handlers.hs b/Omni/Jr/Web/Handlers.hs new file mode 100644 index 0000000..9dd5847 --- /dev/null +++ b/Omni/Jr/Web/Handlers.hs @@ -0,0 +1,649 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- : dep warp +-- : dep servant-server +-- : dep lucid +-- : dep servant-lucid +-- : dep process +-- : dep aeson +module Omni.Jr.Web.Handlers + ( API, + server, + api, + streamAgentEvents, + ) +where + +import Alpha +import qualified Control.Concurrent as Concurrent +import qualified Data.Aeson as Aeson +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LazyText +import Data.Time (getCurrentTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import qualified Omni.Fact as Fact +import qualified Omni.Jr.Web.Style as Style +import Omni.Jr.Web.Types +import qualified Omni.Task.Core as TaskCore +import Servant +import qualified Servant.HTML.Lucid as Lucid +import qualified Servant.Types.SourceT as Source +import qualified System.Exit as Exit +import qualified System.Process as Process + +type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent) + +type API = + QueryParam "range" Text :> Get '[Lucid.HTML] HomePage + :<|> "style.css" :> Get '[CSS] LazyText.Text + :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage + :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage + :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage + :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage + :<|> "tasks" + :> QueryParam "status" Text + :> QueryParam "priority" Text + :> QueryParam "namespace" Text + :> QueryParam "type" Text + :> QueryParam "sort" Text + :> Get '[Lucid.HTML] TaskListPage + :<|> "kb" :> Get '[Lucid.HTML] KBPage + :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect + :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage + :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect + :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect + :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage + :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage + :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial + :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial + :<|> "tasks" :> Capture "id" Text :> "complexity" :> ReqBody '[FormUrlEncoded] ComplexityForm :> Post '[Lucid.HTML] ComplexityBadgePartial + :<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial + :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial + :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial + :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage + :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage + :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect + :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect + :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial + :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial + :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial + :<|> "partials" + :> "task-list" + :> QueryParam "status" Text + :> QueryParam "priority" Text + :> QueryParam "namespace" Text + :> QueryParam "type" Text + :> QueryParam "sort" Text + :> Get '[Lucid.HTML] TaskListPartial + :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial + :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial + :<|> "tasks" :> Capture "id" Text :> "events" :> "stream" :> StreamGet NoFraming SSE (SourceIO ByteString) + +api :: Proxy API +api = Proxy + +server :: Server API +server = + homeHandler + :<|> styleHandler + :<|> readyQueueHandler + :<|> blockedHandler + :<|> interventionHandler + :<|> statsHandler + :<|> taskListHandler + :<|> kbHandler + :<|> factCreateHandler + :<|> factDetailHandler + :<|> factEditHandler + :<|> factDeleteHandler + :<|> epicsHandler + :<|> taskDetailHandler + :<|> taskStatusHandler + :<|> taskPriorityHandler + :<|> taskComplexityHandler + :<|> descriptionViewHandler + :<|> descriptionEditHandler + :<|> descriptionPostHandler + :<|> taskNotesHandler + :<|> taskCommentHandler + :<|> taskReviewHandler + :<|> taskDiffHandler + :<|> taskAcceptHandler + :<|> taskRejectHandler + :<|> taskResetRetriesHandler + :<|> recentActivityNewHandler + :<|> recentActivityMoreHandler + :<|> readyCountHandler + :<|> taskListPartialHandler + :<|> taskMetricsPartialHandler + :<|> agentEventsPartialHandler + :<|> taskEventsStreamHandler + where + styleHandler :: Servant.Handler LazyText.Text + styleHandler = pure Style.css + + homeHandler :: Maybe Text -> Servant.Handler HomePage + homeHandler maybeRangeText = do + now <- liftIO getCurrentTime + let range = parseTimeRange maybeRangeText + maybeStart = getTimeRangeStart range now + allTasks <- liftIO TaskCore.loadTasks + let filteredTasks = case maybeStart of + Nothing -> allTasks + Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start] + stats = TaskCore.computeTaskStatsFromList filteredTasks + readyTasks <- liftIO TaskCore.getReadyTasks + allActivities <- liftIO <| concat </ traverse (TaskCore.getActivitiesForTask <. TaskCore.taskId) allTasks + let filteredActivities = case maybeStart of + Nothing -> allActivities + Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start] + globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities + sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks + recentTasks = take 5 sortedTasks + hasMoreRecent = length filteredTasks > 5 + pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now) + + readyQueueHandler :: Maybe Text -> Servant.Handler ReadyQueuePage + readyQueueHandler maybeSortText = do + now <- liftIO getCurrentTime + readyTasks <- liftIO TaskCore.getReadyTasks + let sortOrder = parseSortOrder maybeSortText + sortedTasks = sortTasks sortOrder readyTasks + pure (ReadyQueuePage sortedTasks sortOrder now) + + blockedHandler :: Maybe Text -> Servant.Handler BlockedPage + blockedHandler maybeSortText = do + now <- liftIO getCurrentTime + blockedTasks <- liftIO TaskCore.getBlockedTasks + allTasks <- liftIO TaskCore.loadTasks + let sortOrder = parseSortOrder maybeSortText + tasksWithImpact = [(t, TaskCore.getBlockingImpact allTasks t) | t <- blockedTasks] + sorted = List.sortBy (comparing (Down <. snd)) tasksWithImpact + pure (BlockedPage sorted sortOrder now) + + interventionHandler :: Maybe Text -> Servant.Handler InterventionPage + interventionHandler maybeSortText = do + now <- liftIO getCurrentTime + actionItems <- liftIO TaskCore.getHumanActionItems + let sortOrder = parseSortOrder maybeSortText + pure (InterventionPage actionItems sortOrder now) + + statsHandler :: Maybe Text -> Servant.Handler StatsPage + statsHandler maybeEpic = do + let epicId = emptyToNothing maybeEpic + stats <- liftIO <| TaskCore.getTaskStats epicId + pure (StatsPage stats epicId) + + taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage + taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do + now <- liftIO getCurrentTime + allTasks <- liftIO TaskCore.loadTasks + let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText + maybePriority = parsePriority =<< emptyToNothing maybePriorityText + maybeType = parseTaskType =<< emptyToNothing maybeTypeText + filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType + sortOrder = parseSortOrder maybeSortText + filteredTasks = sortTasks sortOrder (applyFilters filters allTasks) + pure (TaskListPage filteredTasks filters sortOrder now) + + kbHandler :: Servant.Handler KBPage + kbHandler = do + facts <- liftIO Fact.getAllFacts + pure (KBPage facts) + + factCreateHandler :: FactCreateForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + factCreateHandler (FactCreateForm project content filesText confText) = do + let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText)) + confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText)) + fid <- liftIO (Fact.createFact project content files Nothing confidence) + pure <| addHeader ("/kb/" <> tshow fid) NoContent + + factDetailHandler :: Int -> Servant.Handler FactDetailPage + factDetailHandler fid = do + now <- liftIO getCurrentTime + maybeFact <- liftIO (Fact.getFact fid) + case maybeFact of + Nothing -> pure (FactDetailNotFound fid) + Just fact -> pure (FactDetailFound fact now) + + factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + factEditHandler fid (FactEditForm content filesText confText) = do + let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText)) + confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText)) + liftIO (Fact.updateFact fid content files confidence) + pure <| addHeader ("/kb/" <> tshow fid) NoContent + + factDeleteHandler :: Int -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + factDeleteHandler fid = do + liftIO (Fact.deleteFact fid) + pure <| addHeader "/kb" NoContent + + epicsHandler :: Maybe Text -> Servant.Handler EpicsPage + epicsHandler maybeSortText = do + allTasks <- liftIO TaskCore.loadTasks + let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks + sortOrder = parseSortOrder maybeSortText + sortedEpics = sortTasks sortOrder epicTasks + pure (EpicsPage sortedEpics allTasks sortOrder) + + parseStatus :: Text -> Maybe TaskCore.Status + parseStatus = readMaybe <. Text.unpack + + parsePriority :: Text -> Maybe TaskCore.Priority + parsePriority = readMaybe <. Text.unpack + + parseTaskType :: Text -> Maybe TaskCore.TaskType + parseTaskType = readMaybe <. Text.unpack + + emptyToNothing :: Maybe Text -> Maybe Text + emptyToNothing (Just t) | Text.null (Text.strip t) = Nothing + emptyToNothing x = x + + applyFilters :: TaskFilters -> [TaskCore.Task] -> [TaskCore.Task] + applyFilters filters = filter matchesAllFilters + where + matchesAllFilters task = + matchesStatus task + && matchesPriority task + && matchesNamespace task + && matchesType task + + matchesStatus task = case filterStatus filters of + Nothing -> True + Just s -> TaskCore.taskStatus task == s + + matchesPriority task = case filterPriority filters of + Nothing -> True + Just p -> TaskCore.taskPriority task == p + + matchesNamespace task = case filterNamespace filters of + Nothing -> True + Just ns -> case TaskCore.taskNamespace task of + Nothing -> False + Just taskNs -> ns `Text.isPrefixOf` taskNs + + matchesType task = case filterType filters of + Nothing -> True + Just t -> TaskCore.taskType task == t + + taskDetailHandler :: Text -> Servant.Handler TaskDetailPage + taskDetailHandler tid = do + now <- liftIO getCurrentTime + tasks <- liftIO TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> pure (TaskDetailNotFound tid) + Just task -> do + activities <- liftIO (TaskCore.getActivitiesForTask tid) + retryCtx <- liftIO (TaskCore.getRetryContext tid) + commits <- liftIO (getCommitsForTask tid) + aggMetrics <- + if TaskCore.taskType task == TaskCore.Epic + then Just </ liftIO (TaskCore.getAggregatedMetrics tid) + else pure Nothing + agentEvents <- liftIO (TaskCore.getAllEventsForTask tid) + pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now) + + taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial + taskStatusHandler tid (StatusForm newStatus) = do + liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human + pure (StatusBadgePartial newStatus tid) + + taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial + taskPriorityHandler tid (PriorityForm newPriority) = do + _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority}) + pure (PriorityBadgePartial newPriority tid) + + taskComplexityHandler :: Text -> ComplexityForm -> Servant.Handler ComplexityBadgePartial + taskComplexityHandler tid (ComplexityForm newComplexity) = do + _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskComplexity = newComplexity}) + pure (ComplexityBadgePartial newComplexity tid) + + descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial + descriptionViewHandler tid = do + tasks <- liftIO TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> throwError err404 + Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic)) + + descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial + descriptionEditHandler tid = do + tasks <- liftIO TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> throwError err404 + Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic)) + + descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial + descriptionPostHandler tid (DescriptionForm desc) = do + let descText = Text.strip desc + _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText}) + tasks <- liftIO TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> throwError err404 + Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic)) + + taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskNotesHandler tid (NotesForm notes) = do + liftIO <| TaskCore.updateRetryNotes tid notes + pure <| addHeader ("/tasks/" <> tid) NoContent + + taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskCommentHandler tid (CommentForm commentText) = do + _ <- liftIO (TaskCore.addComment tid commentText TaskCore.Human) + pure <| addHeader ("/tasks/" <> tid) NoContent + + taskReviewHandler :: Text -> Servant.Handler TaskReviewPage + taskReviewHandler tid = do + tasks <- liftIO TaskCore.loadTasks + case TaskCore.findTask tid tasks of + Nothing -> pure (ReviewPageNotFound tid) + Just task -> do + reviewInfo <- liftIO <| getReviewInfo tid + pure (ReviewPageFound task reviewInfo) + + taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage + taskDiffHandler tid commitSha = do + diffOutput <- liftIO <| getDiffForCommit commitSha + case diffOutput of + Nothing -> pure (DiffPageNotFound tid commitSha) + Just output -> pure (DiffPageFound tid commitSha output) + + taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskAcceptHandler tid = do + liftIO <| do + TaskCore.clearRetryContext tid + TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human + pure <| addHeader ("/tasks/" <> tid) NoContent + + taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskRejectHandler tid (RejectForm maybeNotes) = do + liftIO <| do + maybeCommit <- findCommitForTask tid + let commitSha = fromMaybe "" maybeCommit + maybeCtx <- TaskCore.getRetryContext tid + let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx + let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes + let accumulatedReason = case maybeCtx of + Nothing -> currentReason + Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason + TaskCore.setRetryContext + TaskCore.RetryContext + { TaskCore.retryTaskId = tid, + TaskCore.retryOriginalCommit = commitSha, + TaskCore.retryConflictFiles = [], + TaskCore.retryAttempt = attempt, + TaskCore.retryReason = accumulatedReason, + TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes + } + TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human + pure <| addHeader ("/tasks/" <> tid) NoContent + + taskResetRetriesHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent) + taskResetRetriesHandler tid = do + liftIO <| do + TaskCore.clearRetryContext tid + TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human + pure <| addHeader ("/tasks/" <> tid) NoContent + + recentActivityNewHandler :: Maybe Int -> Servant.Handler RecentActivityNewPartial + recentActivityNewHandler maybeSince = do + allTasks <- liftIO TaskCore.loadTasks + let sinceTime = maybe (posixSecondsToUTCTime 0) (posixSecondsToUTCTime <. fromIntegral) maybeSince + sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks + newTasks = filter (\t -> TaskCore.taskUpdatedAt t > sinceTime) sortedTasks + newestTs = maybe maybeSince (Just <. taskToUnixTs) (head newTasks) + pure (RecentActivityNewPartial newTasks newestTs) + + recentActivityMoreHandler :: Maybe Int -> Servant.Handler RecentActivityMorePartial + recentActivityMoreHandler maybeOffset = do + allTasks <- liftIO TaskCore.loadTasks + let offset = fromMaybe 0 maybeOffset + pageSize = 5 + sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks + pageTasks = take pageSize <| drop offset sortedTasks + hasMore = length sortedTasks > offset + pageSize + nextOffset = offset + pageSize + pure (RecentActivityMorePartial pageTasks nextOffset hasMore) + + readyCountHandler :: Servant.Handler ReadyCountPartial + readyCountHandler = do + readyTasks <- liftIO TaskCore.getReadyTasks + pure (ReadyCountPartial (length readyTasks)) + + taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial + taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do + allTasks <- liftIO TaskCore.loadTasks + let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText + maybePriority = parsePriority =<< emptyToNothing maybePriorityText + maybeType = parseTaskType =<< emptyToNothing maybeTypeText + filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType + sortOrder = parseSortOrder maybeSortText + filteredTasks = sortTasks sortOrder (applyFilters filters allTasks) + pure (TaskListPartial filteredTasks) + + taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial + taskMetricsPartialHandler tid = do + now <- liftIO getCurrentTime + activities <- liftIO (TaskCore.getActivitiesForTask tid) + maybeRetry <- liftIO (TaskCore.getRetryContext tid) + pure (TaskMetricsPartial tid activities maybeRetry now) + + agentEventsPartialHandler :: Text -> Maybe Int -> Servant.Handler AgentEventsPartial + agentEventsPartialHandler tid _maybeSince = do + now <- liftIO getCurrentTime + events <- liftIO (TaskCore.getAllEventsForTask tid) + tasks <- liftIO TaskCore.loadTasks + let isInProgress = case TaskCore.findTask tid tasks of + Nothing -> False + Just task -> TaskCore.taskStatus task == TaskCore.InProgress + pure (AgentEventsPartial tid events isInProgress now) + + taskEventsStreamHandler :: Text -> Servant.Handler (SourceIO ByteString) + taskEventsStreamHandler tid = do + maybeSession <- liftIO (TaskCore.getLatestSessionForTask tid) + case maybeSession of + Nothing -> pure (Source.source []) + Just sid -> liftIO (streamAgentEvents tid sid) + +streamAgentEvents :: Text -> Text -> IO (SourceIO ByteString) +streamAgentEvents tid sid = do + existingEvents <- TaskCore.getEventsForSession sid + let lastId = if null existingEvents then 0 else maximum (map TaskCore.storedEventId existingEvents) + let existingSSE = map eventToSSE existingEvents + pure <| Source.fromStepT <| streamEventsStep tid sid lastId existingSSE True + +streamEventsStep :: Text -> Text -> Int -> [ByteString] -> Bool -> Source.StepT IO ByteString +streamEventsStep tid sid lastId buffer sendExisting = case (sendExisting, buffer) of + (True, b : bs) -> Source.Yield b (streamEventsStep tid sid lastId bs True) + (True, []) -> streamEventsStep tid sid lastId [] False + (False, _) -> + Source.Effect <| do + tasks <- TaskCore.loadTasks + let isComplete = case TaskCore.findTask tid tasks of + Nothing -> True + Just task -> TaskCore.taskStatus task /= TaskCore.InProgress + + if isComplete + then do + let completeSSE = formatSSE "complete" "{}" + pure <| Source.Yield completeSSE Source.Stop + else do + Concurrent.threadDelay 500000 + newEvents <- TaskCore.getEventsSince sid lastId + if null newEvents + then pure <| streamEventsStep tid sid lastId [] False + else do + let newLastId = maximum (map TaskCore.storedEventId newEvents) + let newSSE = map eventToSSE newEvents + case newSSE of + (e : es) -> pure <| Source.Yield e (streamEventsStep tid sid newLastId es False) + [] -> pure <| streamEventsStep tid sid newLastId [] False + +eventToSSE :: TaskCore.StoredEvent -> ByteString +eventToSSE event = + let eventType = Text.toLower (TaskCore.storedEventType event) + content = TaskCore.storedEventContent event + jsonData = case eventType of + "assistant" -> Aeson.object ["content" Aeson..= content] + "toolcall" -> + let (tool, args) = parseToolCallContent content + in Aeson.object ["tool" Aeson..= tool, "args" Aeson..= Aeson.object ["data" Aeson..= args]] + "toolresult" -> + Aeson.object ["tool" Aeson..= ("unknown" :: Text), "success" Aeson..= True, "output" Aeson..= content] + "cost" -> Aeson.object ["cost" Aeson..= content] + "error" -> Aeson.object ["error" Aeson..= content] + "complete" -> Aeson.object [] + _ -> Aeson.object ["content" Aeson..= content] + in formatSSE eventType (str (Aeson.encode jsonData)) + +formatSSE :: Text -> ByteString -> ByteString +formatSSE eventType jsonData = + str + <| "event: " + <> eventType + <> "\n" + <> "data: " + <> str jsonData + <> "\n\n" + +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)) + +taskToUnixTs :: TaskCore.Task -> Int +taskToUnixTs t = ceiling (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t)) + +getReviewInfo :: Text -> IO ReviewInfo +getReviewInfo tid = do + maybeCommit <- findCommitForTask tid + case maybeCommit of + Nothing -> pure ReviewNoCommit + Just commitSha -> do + conflictResult <- checkMergeConflict (Text.unpack commitSha) + case conflictResult of + Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles) + Nothing -> do + (_, diffOut, _) <- + Process.readProcessWithExitCode + "git" + ["show", Text.unpack commitSha] + "" + pure (ReviewReady commitSha (Text.pack diffOut)) + +getDiffForCommit :: Text -> IO (Maybe Text) +getDiffForCommit commitSha = do + (code, diffOut, _) <- + Process.readProcessWithExitCode + "git" + ["show", Text.unpack commitSha] + "" + case code of + Exit.ExitSuccess -> pure (Just (Text.pack diffOut)) + Exit.ExitFailure _ -> pure Nothing + +findCommitForTask :: Text -> IO (Maybe Text) +findCommitForTask tid = do + let grepArg = "--grep=" <> Text.unpack tid + (code, shaOut, _) <- + Process.readProcessWithExitCode + "git" + ["log", "--pretty=format:%H", "-n", "1", grepArg] + "" + if code /= Exit.ExitSuccess || null shaOut + then pure Nothing + else case List.lines shaOut of + (x : _) -> pure (Just (Text.pack x)) + [] -> pure Nothing + +getCommitsForTask :: Text -> IO [GitCommit] +getCommitsForTask tid = do + let grepArg = "--grep=Task-Id: " <> Text.unpack tid + (code, out, _) <- + Process.readProcessWithExitCode + "git" + ["log", "--pretty=format:%H|%h|%s|%an|%ar", grepArg] + "" + if code /= Exit.ExitSuccess || null out + then pure [] + else do + let commitLines = filter (not <. null) (List.lines out) + traverse parseCommitLine commitLines + where + parseCommitLine :: String -> IO GitCommit + parseCommitLine line = + case Text.splitOn "|" (Text.pack line) of + [sha, shortSha, summary, author, relDate] -> do + filesCount <- getFilesChangedCount (Text.unpack sha) + pure + GitCommit + { commitHash = sha, + commitShortHash = shortSha, + commitSummary = summary, + commitAuthor = author, + commitRelativeDate = relDate, + commitFilesChanged = filesCount + } + _ -> + pure + GitCommit + { commitHash = Text.pack line, + commitShortHash = Text.take 7 (Text.pack line), + commitSummary = "(parse error)", + commitAuthor = "", + commitRelativeDate = "", + commitFilesChanged = 0 + } + + getFilesChangedCount :: String -> IO Int + getFilesChangedCount sha = do + (code', out', _) <- + Process.readProcessWithExitCode + "git" + ["show", "--stat", "--format=", sha] + "" + pure + <| if code' /= Exit.ExitSuccess + then 0 + else + let statLines = filter (not <. null) (List.lines out') + in max 0 (length statLines - 1) + +checkMergeConflict :: String -> IO (Maybe [Text]) +checkMergeConflict commitSha = do + (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] "" + + (cpCode, _, cpErr) <- + Process.readProcessWithExitCode + "git" + ["cherry-pick", "--no-commit", commitSha] + "" + + _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] "" + _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] "" + + case cpCode of + Exit.ExitSuccess -> pure Nothing + Exit.ExitFailure _ -> do + let errLines = Text.lines (Text.pack cpErr) + conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines + files = mapMaybe extractConflictFile conflictLines + pure (Just (if null files then ["(unknown files)"] else files)) + +extractConflictFile :: Text -> Maybe Text +extractConflictFile line = + case Text.breakOn "Merge conflict in " line of + (_, rest) + | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest)) + _ -> case Text.breakOn "in " line of + (_, rest) + | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest)) + _ -> Nothing diff --git a/Omni/Jr/Web/Pages.hs b/Omni/Jr/Web/Pages.hs new file mode 100644 index 0000000..b3cc8ea --- /dev/null +++ b/Omni/Jr/Web/Pages.hs @@ -0,0 +1,862 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- : dep lucid +-- : dep servant-lucid +module Omni.Jr.Web.Pages + ( -- * Re-export page types + module Omni.Jr.Web.Types, + ) +where + +import Alpha +import qualified Data.Text as Text +import Data.Time (utctDayTime) +import qualified Lucid +import qualified Lucid.Base as Lucid +import Numeric (showFFloat) +import Omni.Jr.Web.Components + ( Breadcrumb (..), + complexityBadgeWithForm, + metaSep, + multiColorProgressBar, + pageBody, + pageBodyWithCrumbs, + pageHead, + priorityBadgeWithForm, + renderAggregatedMetrics, + renderBlockedTaskCard, + renderEpicCardWithStats, + renderEpicReviewCard, + renderListGroupItem, + renderRelativeTimestamp, + renderRetryContextBanner, + renderTaskCard, + renderUnifiedTimeline, + sortDropdown, + statusBadge, + statusBadgeWithForm, + taskBreadcrumbs, + ) +import Omni.Jr.Web.Partials () +import Omni.Jr.Web.Types + ( BlockedPage (..), + DescriptionViewPartial (..), + EpicsPage (..), + FactDetailPage (..), + GitCommit (..), + HomePage (..), + InterventionPage (..), + KBPage (..), + ReadyQueuePage (..), + ReviewInfo (..), + SortOrder (..), + StatsPage (..), + TaskDetailPage (..), + TaskDiffPage (..), + TaskFilters (..), + TaskListPage (..), + TaskReviewPage (..), + TimeRange (..), + filterNamespace, + filterPriority, + filterStatus, + sortOrderToParam, + sortTasks, + timeRangeToParam, + ) +import qualified Omni.Task.Core as TaskCore + +taskToUnixTs :: TaskCore.Task -> Int +taskToUnixTs t = + let ts = TaskCore.taskUpdatedAt t + in floor (realToFrac (utctDayTime ts) :: Double) + +instance Lucid.ToHtml HomePage where + toHtmlRaw = Lucid.toHtml + toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics currentRange _now) = + Lucid.doctypehtml_ <| do + pageHead "Jr Dashboard" + pageBody <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h2_ "Task Status" + Lucid.div_ [Lucid.class_ "time-filter"] <| do + timeFilterBtn "Today" Today currentRange + timeFilterBtn "This Week" Week currentRange + timeFilterBtn "This Month" Month currentRange + timeFilterBtn "All Time" AllTime currentRange + Lucid.div_ [Lucid.class_ "stats-grid"] <| do + statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open" + statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress" + statCard "Review" (TaskCore.reviewTasks stats) "badge-review" "/tasks?status=Review" + statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" "/tasks?status=Approved" + statCard "Done" (TaskCore.doneTasks stats) "badge-done" "/tasks?status=Done" + metricCard "Cost" (formatCost (TaskCore.aggTotalCostCents globalMetrics)) + metricCard "Duration" (formatDuration (TaskCore.aggTotalDurationSeconds globalMetrics)) + + Lucid.h2_ <| do + "Ready Queue " + Lucid.span_ + [ Lucid.class_ "ready-count", + Lucid.makeAttribute "hx-get" "/partials/ready-count", + Lucid.makeAttribute "hx-trigger" "every 5s" + ] + <| do + Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] + <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)") + if null readyTasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work." + else + Lucid.div_ [Lucid.class_ "list-group"] + <| traverse_ renderListGroupItem (take 5 readyTasks) + + Lucid.h2_ "Recent Activity" + let newestTimestamp = maybe 0 taskToUnixTs (head recentTasks) + Lucid.div_ + [ Lucid.class_ "recent-activity", + Lucid.id_ "recent-activity", + Lucid.makeAttribute "data-newest-ts" (tshow newestTimestamp), + Lucid.makeAttribute "hx-get" "/partials/recent-activity-new", + Lucid.makeAttribute "hx-trigger" "every 10s", + Lucid.makeAttribute "hx-vals" "js:{since: document.getElementById('recent-activity')?.dataset?.newestTs || 0}", + Lucid.makeAttribute "hx-target" "#activity-list", + Lucid.makeAttribute "hx-swap" "afterbegin" + ] + <| do + Lucid.div_ [Lucid.id_ "activity-list", Lucid.class_ "list-group"] + <| traverse_ renderListGroupItem recentTasks + when hasMoreRecent + <| Lucid.button_ + [ Lucid.id_ "activity-load-more", + Lucid.class_ "btn btn-secondary load-more-btn", + Lucid.makeAttribute "hx-get" "/partials/recent-activity-more?offset=5", + Lucid.makeAttribute "hx-target" "#activity-list", + Lucid.makeAttribute "hx-swap" "beforeend" + ] + "Load More" + where + statCard :: (Monad m) => Text -> Int -> Text -> Text -> Lucid.HtmlT m () + statCard label count badgeClass href = + Lucid.a_ [Lucid.href_ href, Lucid.class_ ("stat-card " <> badgeClass)] <| do + Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count)) + Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + + metricCard :: (Monad m) => Text -> Text -> Lucid.HtmlT m () + metricCard label value = + Lucid.div_ [Lucid.class_ "stat-card badge-neutral"] <| do + Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml value) + Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + + formatCost :: Int -> Text + formatCost cents = + let dollars = fromIntegral cents / 100.0 :: Double + in Text.pack ("$" <> showFFloat (Just 2) dollars "") + + formatDuration :: Int -> Text + formatDuration totalSeconds + | totalSeconds < 60 = tshow totalSeconds <> "s" + | totalSeconds < 3600 = + let mins = totalSeconds `div` 60 + in tshow mins <> "m" + | otherwise = + let hours = totalSeconds `div` 3600 + mins = (totalSeconds `mod` 3600) `div` 60 + in tshow hours <> "h " <> tshow mins <> "m" + + timeFilterBtn :: (Monad m) => Text -> TimeRange -> TimeRange -> Lucid.HtmlT m () + timeFilterBtn label range current = + let activeClass = if range == current then " active" else "" + href = "/?" <> "range=" <> timeRangeToParam range + in Lucid.a_ + [ Lucid.href_ href, + Lucid.class_ ("time-filter-btn" <> activeClass) + ] + (Lucid.toHtml label) + +instance Lucid.ToHtml ReadyQueuePage where + toHtmlRaw = Lucid.toHtml + toHtml (ReadyQueuePage tasks currentSort _now) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Ready Queue" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Ready Queue - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "page-header-row"] <| do + Lucid.h1_ <| Lucid.toHtml ("Ready Queue (" <> tshow (length tasks) <> " tasks)") + sortDropdown "/ready" currentSort + if null tasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks are ready for work." + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks + +instance Lucid.ToHtml BlockedPage where + toHtmlRaw = Lucid.toHtml + toHtml (BlockedPage tasksWithImpact currentSort _now) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Blocked" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Blocked Tasks - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "page-header-row"] <| do + Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasksWithImpact) <> " tasks)") + sortDropdown "/blocked" currentSort + Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies, sorted by blocking impact." + if null tasksWithImpact + then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks." + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderBlockedTaskCard tasksWithImpact + +instance Lucid.ToHtml InterventionPage where + toHtmlRaw = Lucid.toHtml + toHtml (InterventionPage actionItems currentSort _now) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Human Action" Nothing] + failed = TaskCore.failedTasks actionItems + epicsReady = TaskCore.epicsInReview actionItems + needsHelp = TaskCore.tasksNeedingHelp actionItems + totalCount = length failed + length epicsReady + length needsHelp + in Lucid.doctypehtml_ <| do + pageHead "Needs Human Action - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "page-header-row"] <| do + Lucid.h1_ <| Lucid.toHtml ("Needs Human Action (" <> tshow totalCount <> " items)") + sortDropdown "/intervention" currentSort + if totalCount == 0 + then Lucid.p_ [Lucid.class_ "empty-msg"] "No items need human action." + else do + unless (null failed) <| do + Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Failed Tasks (" <> tshow (length failed) <> ")") + Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help." + Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort failed) + unless (null epicsReady) <| do + Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Epics Ready for Review (" <> tshow (length epicsReady) <> ")") + Lucid.p_ [Lucid.class_ "info-msg"] "Epics with all children completed. Verify before closing." + Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicReviewCard epicsReady + unless (null needsHelp) <| do + Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Needs Help (" <> tshow (length needsHelp) <> ")") + Lucid.p_ [Lucid.class_ "info-msg"] "Tasks where Jr needs human guidance or decisions." + Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort needsHelp) + +instance Lucid.ToHtml KBPage where + toHtmlRaw = Lucid.toHtml + toHtml (KBPage facts) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Knowledge Base - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Knowledge Base" + Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution." + + Lucid.details_ [Lucid.class_ "create-fact-section"] <| do + Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact" + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ "/kb/create", + Lucid.class_ "fact-create-form" + ] + <| do + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "project"] "Project:" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "project", + Lucid.id_ "project", + Lucid.class_ "form-input", + Lucid.required_ "required", + Lucid.placeholder_ "e.g., Omni/Jr" + ] + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "content"] "Fact Content:" + Lucid.textarea_ + [ Lucid.name_ "content", + Lucid.id_ "content", + Lucid.class_ "form-textarea", + Lucid.rows_ "4", + Lucid.required_ "required", + Lucid.placeholder_ "Describe the fact or knowledge..." + ] + "" + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "files", + Lucid.id_ "files", + Lucid.class_ "form-input", + Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs" + ] + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):" + Lucid.input_ + [ Lucid.type_ "number", + Lucid.name_ "confidence", + Lucid.id_ "confidence", + Lucid.class_ "form-input", + Lucid.step_ "0.1", + Lucid.min_ "0", + Lucid.max_ "1", + Lucid.value_ "0.8" + ] + Lucid.div_ [Lucid.class_ "form-actions"] <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact" + + if null facts + then Lucid.p_ [Lucid.class_ "empty-msg"] "No facts recorded yet." + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderFactCard facts + where + renderFactCard :: (Monad m) => TaskCore.Fact -> Lucid.HtmlT m () + renderFactCard f = + let factUrl = "/kb/" <> maybe "-" tshow (TaskCore.factId f) + in Lucid.a_ + [ Lucid.class_ "task-card task-card-link", + Lucid.href_ factUrl + ] + <| do + Lucid.div_ [Lucid.class_ "task-header"] <| do + Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (maybe "-" tshow (TaskCore.factId f))) + confidenceBadge (TaskCore.factConfidence f) + Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (TaskCore.factProject f)) + Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (Text.take 80 (TaskCore.factContent f) <> if Text.length (TaskCore.factContent f) > 80 then "..." else "")) + unless (null (TaskCore.factRelatedFiles f)) <| do + Lucid.p_ [Lucid.class_ "kb-files"] <| do + Lucid.span_ [Lucid.class_ "files-label"] "Files: " + Lucid.toHtml (Text.intercalate ", " (take 3 (TaskCore.factRelatedFiles f))) + when (length (TaskCore.factRelatedFiles f) > 3) <| do + Lucid.toHtml (" +" <> tshow (length (TaskCore.factRelatedFiles f) - 3) <> " more") + + confidenceBadge :: (Monad m) => Double -> Lucid.HtmlT m () + confidenceBadge conf = + let pct = floor (conf * 100) :: Int + cls + | conf >= 0.8 = "badge badge-done" + | conf >= 0.5 = "badge badge-inprogress" + | otherwise = "badge badge-open" + in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%")) + +instance Lucid.ToHtml FactDetailPage where + toHtmlRaw = Lucid.toHtml + toHtml (FactDetailNotFound fid) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> tshow fid) Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Fact Not Found - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Fact Not Found" + Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found.")) + Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base" + toHtml (FactDetailFound fact now) = + let fid' = maybe "-" tshow (TaskCore.factId fact) + crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> fid') Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Fact Detail - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "task-detail-header"] <| do + Lucid.h1_ <| do + Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact))) + Lucid.div_ [Lucid.class_ "task-meta-row"] <| do + Lucid.span_ [Lucid.class_ "meta-label"] "Project:" + Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact)) + Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:" + confidenceBadgeDetail (TaskCore.factConfidence fact) + Lucid.span_ [Lucid.class_ "meta-label"] "Created:" + Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact)) + + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h2_ "Content" + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/edit"), + Lucid.class_ "fact-edit-form" + ] + <| do + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "content"] "Fact Content:" + Lucid.textarea_ + [ Lucid.name_ "content", + Lucid.id_ "content", + Lucid.class_ "form-textarea", + Lucid.rows_ "6" + ] + (Lucid.toHtml (TaskCore.factContent fact)) + + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "files", + Lucid.id_ "files", + Lucid.class_ "form-input", + Lucid.value_ (Text.intercalate ", " (TaskCore.factRelatedFiles fact)) + ] + + Lucid.div_ [Lucid.class_ "form-group"] <| do + Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):" + Lucid.input_ + [ Lucid.type_ "number", + Lucid.name_ "confidence", + Lucid.id_ "confidence", + Lucid.class_ "form-input", + Lucid.step_ "0.1", + Lucid.min_ "0", + Lucid.max_ "1", + Lucid.value_ (tshow (TaskCore.factConfidence fact)) + ] + + Lucid.div_ [Lucid.class_ "form-actions"] <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save Changes" + + case TaskCore.factSourceTask fact of + Nothing -> pure () + Just tid -> do + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h2_ "Source Task" + Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid) + + Lucid.div_ [Lucid.class_ "detail-section danger-zone"] <| do + Lucid.h2_ "Danger Zone" + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/delete"), + Lucid.class_ "delete-form", + Lucid.makeAttribute "onsubmit" "return confirm('Are you sure you want to delete this fact?');" + ] + <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-danger"] "Delete Fact" + + Lucid.div_ [Lucid.class_ "back-link"] <| do + Lucid.a_ [Lucid.href_ "/kb"] "← Back to Knowledge Base" + where + confidenceBadgeDetail :: (Monad m) => Double -> Lucid.HtmlT m () + confidenceBadgeDetail conf = + let pct = floor (conf * 100) :: Int + cls + | conf >= 0.8 = "badge badge-done" + | conf >= 0.5 = "badge badge-inprogress" + | otherwise = "badge badge-open" + in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%")) + +instance Lucid.ToHtml EpicsPage where + toHtmlRaw = Lucid.toHtml + toHtml (EpicsPage epics allTasks currentSort) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Epics" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Epics - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "page-header-row"] <| do + Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")") + sortDropdown "/epics" currentSort + Lucid.p_ [Lucid.class_ "info-msg"] "All epics (large, multi-task projects)." + if null epics + then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found." + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics + +instance Lucid.ToHtml TaskListPage where + toHtmlRaw = Lucid.toHtml + toHtml (TaskListPage tasks filters currentSort _now) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Tasks - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "page-header-row"] <| do + Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")") + sortDropdown "/tasks" currentSort + + Lucid.div_ [Lucid.class_ "filter-form"] <| do + Lucid.form_ + [ Lucid.method_ "GET", + Lucid.action_ "/tasks", + Lucid.makeAttribute "hx-get" "/partials/task-list", + Lucid.makeAttribute "hx-target" "#task-list", + Lucid.makeAttribute "hx-push-url" "/tasks", + Lucid.makeAttribute "hx-trigger" "submit, change from:select" + ] + <| do + Lucid.div_ [Lucid.class_ "filter-row"] <| do + Lucid.div_ [Lucid.class_ "filter-group"] <| do + Lucid.label_ [Lucid.for_ "status"] "Status:" + Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do + Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All" + statusFilterOption TaskCore.Open (filterStatus filters) + statusFilterOption TaskCore.InProgress (filterStatus filters) + statusFilterOption TaskCore.Review (filterStatus filters) + statusFilterOption TaskCore.Approved (filterStatus filters) + statusFilterOption TaskCore.Done (filterStatus filters) + + Lucid.div_ [Lucid.class_ "filter-group"] <| do + Lucid.label_ [Lucid.for_ "priority"] "Priority:" + Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do + Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All" + priorityFilterOption TaskCore.P0 (filterPriority filters) + priorityFilterOption TaskCore.P1 (filterPriority filters) + priorityFilterOption TaskCore.P2 (filterPriority filters) + priorityFilterOption TaskCore.P3 (filterPriority filters) + priorityFilterOption TaskCore.P4 (filterPriority filters) + + Lucid.div_ [Lucid.class_ "filter-group"] <| do + Lucid.label_ [Lucid.for_ "namespace"] "Namespace:" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "namespace", + Lucid.id_ "namespace", + Lucid.class_ "filter-input", + Lucid.placeholder_ "e.g. Omni/Jr", + Lucid.value_ (fromMaybe "" (filterNamespace filters)) + ] + + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter" + Lucid.a_ + [ Lucid.href_ "/tasks", + Lucid.class_ "clear-btn", + Lucid.makeAttribute "hx-get" "/partials/task-list", + Lucid.makeAttribute "hx-target" "#task-list", + Lucid.makeAttribute "hx-push-url" "/tasks" + ] + "Clear" + + Lucid.div_ [Lucid.id_ "task-list"] <| do + if null tasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters." + else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks + where + maybeSelected :: (Eq a) => Maybe a -> Maybe a -> [Lucid.Attribute] + maybeSelected opt current = [Lucid.selected_ "selected" | opt == current] + + statusFilterOption :: (Monad m) => TaskCore.Status -> Maybe TaskCore.Status -> Lucid.HtmlT m () + statusFilterOption s current = + let attrs = [Lucid.value_ (tshow s)] <> [Lucid.selected_ "selected" | Just s == current] + in Lucid.option_ attrs (Lucid.toHtml (tshow s)) + + priorityFilterOption :: (Monad m) => TaskCore.Priority -> Maybe TaskCore.Priority -> Lucid.HtmlT m () + priorityFilterOption p current = + let attrs = [Lucid.value_ (tshow p)] <> [Lucid.selected_ "selected" | Just p == current] + in Lucid.option_ attrs (Lucid.toHtml (tshow p)) + +instance Lucid.ToHtml TaskDetailPage where + toHtmlRaw = Lucid.toHtml + toHtml (TaskDetailNotFound tid) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Task Not Found - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Task Not Found" + Lucid.p_ <| do + "The task " + Lucid.code_ (Lucid.toHtml tid) + " could not be found." + toHtml (TaskDetailFound task allTasks _activities maybeRetry commits maybeAggMetrics agentEvents now) = + let crumbs = taskBreadcrumbs allTasks task + in Lucid.doctypehtml_ <| do + pageHead (TaskCore.taskId task <> " - Jr") + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task) + + renderRetryContextBanner (TaskCore.taskId task) maybeRetry + + Lucid.div_ [Lucid.class_ "task-detail"] <| do + Lucid.div_ [Lucid.class_ "task-meta"] <| do + Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do + Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task)) + metaSep + Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task))) + metaSep + statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task) + metaSep + priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task) + metaSep + complexityBadgeWithForm (TaskCore.taskComplexity task) (TaskCore.taskId task) + case TaskCore.taskNamespace task of + Nothing -> pure () + Just ns -> do + metaSep + Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns) + + Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do + case TaskCore.taskParent task of + Nothing -> pure () + Just pid -> do + Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:" + Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid) + metaSep + Lucid.span_ [Lucid.class_ "task-meta-label"] "Created" + renderRelativeTimestamp now (TaskCore.taskCreatedAt task) + metaSep + Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated" + renderRelativeTimestamp now (TaskCore.taskUpdatedAt task) + + let deps = TaskCore.taskDependencies task + unless (null deps) <| do + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h3_ "Dependencies" + Lucid.ul_ [Lucid.class_ "dep-list"] <| do + traverse_ renderDependency deps + + when (TaskCore.taskType task == TaskCore.Epic) <| do + for_ maybeAggMetrics (renderAggregatedMetrics allTasks task) + + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic)) + + let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks + unless (null children) <| do + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h3_ "Child Tasks" + Lucid.ul_ [Lucid.class_ "child-list"] <| do + traverse_ renderChild children + + unless (null commits) <| do + Lucid.div_ [Lucid.class_ "detail-section"] <| do + Lucid.h3_ "Git Commits" + Lucid.div_ [Lucid.class_ "commit-list"] <| do + traverse_ (renderCommit (TaskCore.taskId task)) commits + + when (TaskCore.taskStatus task == TaskCore.Review) <| do + Lucid.div_ [Lucid.class_ "review-link-section"] <| do + Lucid.a_ + [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"), + Lucid.class_ "review-link-btn" + ] + "Review This Task" + + renderUnifiedTimeline (TaskCore.taskId task) (TaskCore.taskComments task) agentEvents (TaskCore.taskStatus task) now + where + renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m () + renderDependency dep = + Lucid.li_ <| do + Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep)) + Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]") + + renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () + renderChild child = + Lucid.li_ <| do + Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child)) + Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child) + Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]") + + renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m () + renderCommit tid c = + Lucid.div_ [Lucid.class_ "commit-item"] <| do + Lucid.div_ [Lucid.class_ "commit-header"] <| do + Lucid.a_ + [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c), + Lucid.class_ "commit-hash" + ] + (Lucid.toHtml (commitShortHash c)) + Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c)) + Lucid.div_ [Lucid.class_ "commit-meta"] <| do + Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c)) + Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c)) + Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files")) + +instance Lucid.ToHtml TaskReviewPage where + toHtmlRaw = Lucid.toHtml + toHtml (ReviewPageNotFound tid) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Task Not Found - Jr Review" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Task Not Found" + Lucid.p_ <| do + "The task " + Lucid.code_ (Lucid.toHtml tid) + " could not be found." + toHtml (ReviewPageFound task reviewInfo) = + let tid = TaskCore.taskId task + crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing] + in Lucid.doctypehtml_ <| do + pageHead ("Review: " <> TaskCore.taskId task <> " - Jr") + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Review Task" + + Lucid.div_ [Lucid.class_ "task-summary"] <| do + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "ID:" + Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task)) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Title:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task)) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Status:" + Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task) + + case reviewInfo of + ReviewNoCommit -> + Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do + Lucid.h3_ "No Commit Found" + Lucid.p_ "No commit with this task ID was found in the git history." + Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID." + ReviewMergeConflict commitSha conflictFiles -> + Lucid.div_ [Lucid.class_ "conflict-warning"] <| do + Lucid.h3_ "Merge Conflict Detected" + Lucid.p_ <| do + "Commit " + Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha)) + " cannot be cleanly merged." + Lucid.p_ "Conflicting files:" + Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles + ReviewReady commitSha diffText -> do + Lucid.div_ [Lucid.class_ "diff-section"] <| do + Lucid.h3_ <| do + "Commit: " + Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha)) + Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText) + + Lucid.div_ [Lucid.class_ "review-actions"] <| do + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"), + Lucid.class_ "inline-form" + ] + <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept" + + Lucid.form_ + [ Lucid.method_ "POST", + Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"), + Lucid.class_ "reject-form" + ] + <| do + Lucid.textarea_ + [ Lucid.name_ "notes", + Lucid.class_ "reject-notes", + Lucid.placeholder_ "Rejection notes (optional)" + ] + "" + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject" + +instance Lucid.ToHtml TaskDiffPage where + toHtmlRaw = Lucid.toHtml + toHtml (DiffPageNotFound tid commitHash') = + let shortHash = Text.take 8 commitHash' + crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Commit Not Found - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ "Commit Not Found" + Lucid.p_ <| do + "Could not find commit " + Lucid.code_ (Lucid.toHtml commitHash') + Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task" + toHtml (DiffPageFound tid commitHash' diffOutput) = + let shortHash = Text.take 8 commitHash' + crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing] + in Lucid.doctypehtml_ <| do + pageHead ("Diff " <> shortHash <> " - Jr") + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.div_ [Lucid.class_ "diff-header"] <| do + Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task" + Lucid.h1_ <| do + "Commit " + Lucid.code_ (Lucid.toHtml shortHash) + Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput) + +instance Lucid.ToHtml StatsPage where + toHtmlRaw = Lucid.toHtml + toHtml (StatsPage stats maybeEpic) = + let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Stats" Nothing] + in Lucid.doctypehtml_ <| do + pageHead "Task Statistics - Jr" + pageBodyWithCrumbs crumbs <| do + Lucid.div_ [Lucid.class_ "container"] <| do + Lucid.h1_ <| case maybeEpic of + Nothing -> "Task Statistics" + Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId) + + Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do + Lucid.div_ [Lucid.class_ "filter-row"] <| do + Lucid.div_ [Lucid.class_ "filter-group"] <| do + Lucid.label_ [Lucid.for_ "epic"] "Epic:" + Lucid.input_ + [ Lucid.type_ "text", + Lucid.name_ "epic", + Lucid.id_ "epic", + Lucid.class_ "filter-input", + Lucid.placeholder_ "Epic ID (optional)", + Lucid.value_ (fromMaybe "" maybeEpic) + ] + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter" + Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear" + + Lucid.h2_ "By Status" + multiColorProgressBar stats + Lucid.div_ [Lucid.class_ "stats-grid"] <| do + statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats) + statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats) + statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats) + statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats) + statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats) + + Lucid.h2_ "By Priority" + Lucid.div_ [Lucid.class_ "stats-section"] <| do + traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats) + + Lucid.h2_ "By Namespace" + Lucid.div_ [Lucid.class_ "stats-section"] <| do + if null (TaskCore.tasksByNamespace stats) + then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found." + else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats) + + Lucid.h2_ "Summary" + Lucid.div_ [Lucid.class_ "summary-section"] <| do + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Epics:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Ready:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats))) + Lucid.div_ [Lucid.class_ "detail-row"] <| do + Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:" + Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats))) + where + statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m () + statCard label count total = + let pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stat-card"] <| do + Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count)) + Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + + renderPriorityRow :: (Monad m) => TaskCore.Priority -> Int -> Lucid.HtmlT m () + renderPriorityRow priority count = + let total = TaskCore.totalTasks stats + pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stats-row"] <| do + Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml (tshow priority)) + Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) + + renderNamespaceRow :: (Monad m) => Int -> Text -> Int -> Lucid.HtmlT m () + renderNamespaceRow total ns count = + let pct = if total == 0 then 0 else (count * 100) `div` total + in Lucid.div_ [Lucid.class_ "stats-row"] <| do + Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml ns) + Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do + Lucid.div_ [Lucid.class_ "progress-bar"] <| do + Lucid.div_ + [ Lucid.class_ "progress-fill", + Lucid.style_ ("width: " <> tshow pct <> "%") + ] + "" + Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) diff --git a/Omni/Jr/Web/Partials.hs b/Omni/Jr/Web/Partials.hs new file mode 100644 index 0000000..2660441 --- /dev/null +++ b/Omni/Jr/Web/Partials.hs @@ -0,0 +1,274 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- : dep lucid +-- : dep servant-lucid +module Omni.Jr.Web.Partials + ( -- Re-export instances for use by Web.hs + ) +where + +import Alpha +import qualified Data.Text as Text +import Data.Time (UTCTime, diffUTCTime) +import qualified Lucid +import qualified Lucid.Base as Lucid +import Numeric (showFFloat) +import Omni.Jr.Web.Components + ( aggregateCostMetrics, + commentForm, + complexityBadgeWithForm, + formatCostHeader, + formatTokensHeader, + metaSep, + priorityBadgeWithForm, + renderAutoscrollToggle, + renderListGroupItem, + renderLiveToggle, + renderMarkdown, + renderRelativeTimestamp, + renderTimelineEvent, + statusBadgeWithForm, + timelineScrollScript, + ) +import Omni.Jr.Web.Types + ( AgentEventsPartial (..), + ComplexityBadgePartial (..), + DescriptionEditPartial (..), + DescriptionViewPartial (..), + PriorityBadgePartial (..), + ReadyCountPartial (..), + RecentActivityMorePartial (..), + RecentActivityNewPartial (..), + StatusBadgePartial (..), + TaskListPartial (..), + TaskMetricsPartial (..), + ) +import qualified Omni.Task.Core as TaskCore + +instance Lucid.ToHtml RecentActivityNewPartial where + toHtmlRaw = Lucid.toHtml + toHtml (RecentActivityNewPartial tasks maybeNewestTs) = do + traverse_ renderListGroupItem tasks + case maybeNewestTs of + Nothing -> pure () + Just ts -> + Lucid.div_ + [ Lucid.id_ "recent-activity", + Lucid.makeAttribute "data-newest-ts" (tshow ts), + Lucid.makeAttribute "hx-swap-oob" "attributes:#recent-activity data-newest-ts" + ] + "" + +instance Lucid.ToHtml RecentActivityMorePartial where + toHtmlRaw = Lucid.toHtml + toHtml (RecentActivityMorePartial tasks nextOffset hasMore) = do + traverse_ renderListGroupItem tasks + if hasMore + then + Lucid.button_ + [ Lucid.id_ "activity-load-more", + Lucid.class_ "btn btn-secondary load-more-btn", + Lucid.makeAttribute "hx-get" ("/partials/recent-activity-more?offset=" <> tshow nextOffset), + Lucid.makeAttribute "hx-target" "#activity-list", + Lucid.makeAttribute "hx-swap" "beforeend", + Lucid.makeAttribute "hx-swap-oob" "true" + ] + "Load More" + else Lucid.span_ [Lucid.id_ "activity-load-more", Lucid.makeAttribute "hx-swap-oob" "true"] "" + +instance Lucid.ToHtml ReadyCountPartial where + toHtmlRaw = Lucid.toHtml + toHtml (ReadyCountPartial count) = + Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] + <| Lucid.toHtml ("(" <> tshow count <> " tasks)") + +instance Lucid.ToHtml StatusBadgePartial where + toHtmlRaw = Lucid.toHtml + toHtml (StatusBadgePartial status tid) = + statusBadgeWithForm status tid + +instance Lucid.ToHtml PriorityBadgePartial where + toHtmlRaw = Lucid.toHtml + toHtml (PriorityBadgePartial priority tid) = + priorityBadgeWithForm priority tid + +instance Lucid.ToHtml ComplexityBadgePartial where + toHtmlRaw = Lucid.toHtml + toHtml (ComplexityBadgePartial complexity tid) = + complexityBadgeWithForm complexity tid + +instance Lucid.ToHtml TaskListPartial where + toHtmlRaw = Lucid.toHtml + toHtml (TaskListPartial tasks) = + if null tasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters." + else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks + +instance Lucid.ToHtml TaskMetricsPartial where + toHtmlRaw = Lucid.toHtml + toHtml (TaskMetricsPartial _tid activities maybeRetry now) = + let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities + in if null runningActs + then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available." + else + Lucid.div_ [Lucid.class_ "execution-details"] <| do + let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]] + totalDuration = sum [calcDurSecs act | act <- runningActs] + attemptCount = length runningActs + + case maybeRetry of + Nothing -> pure () + Just ctx -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:" + Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3")) + + when (attemptCount > 1) <| do + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:" + Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount)) + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:" + Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration)) + when (totalCost > 0) + <| Lucid.div_ [Lucid.class_ "metric-row"] + <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:" + Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost totalCost)) + Lucid.hr_ [Lucid.class_ "attempts-divider"] + + traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs)) + where + calcDurSecs :: TaskCore.TaskActivity -> Int + calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + + formatDurSecs :: Int -> Text + formatDurSecs secs + | secs < 60 = tshow secs <> "s" + | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s" + | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m" + + renderAttempt :: (Monad m) => Int -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m () + renderAttempt totalAttempts currentTime (attemptNum, act) = do + when (totalAttempts > 1) + <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text)) + case TaskCore.activityThreadUrl act of + Nothing -> pure () + Just url -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Session:" + Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗" + + case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of + (Just start, Just end) -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Duration:" + Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration start end)) + (Just start, Nothing) -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Started:" + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime start) + _ -> pure () + + case TaskCore.activityCostCents act of + Nothing -> pure () + Just cents -> + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Cost:" + Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost cents)) + + Lucid.div_ [Lucid.class_ "metric-row"] <| do + Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:" + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act)) + + formatDuration :: UTCTime -> UTCTime -> Text + formatDuration start end = + let diffSecs = floor (diffUTCTime end start) :: Int + mins = diffSecs `div` 60 + secs = diffSecs `mod` 60 + in if mins > 0 + then tshow mins <> "m " <> tshow secs <> "s" + else tshow secs <> "s" + + formatCost :: Int -> Text + formatCost cents = + let dollars = fromIntegral cents / 100.0 :: Double + in "$" <> Text.pack (showFFloat (Just 2) dollars "") + +instance Lucid.ToHtml DescriptionViewPartial where + toHtmlRaw = Lucid.toHtml + toHtml (DescriptionViewPartial tid desc isEpic) = + Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block"] <| do + Lucid.div_ [Lucid.class_ "description-header"] <| do + Lucid.h3_ (if isEpic then "Design" else "Description") + Lucid.a_ + [ Lucid.href_ "#", + Lucid.class_ "edit-link", + Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"), + Lucid.makeAttribute "hx-target" "#description-block", + Lucid.makeAttribute "hx-swap" "outerHTML" + ] + "Edit" + if Text.null desc + then Lucid.p_ [Lucid.class_ "empty-msg"] (if isEpic then "No design document yet." else "No description yet.") + else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc) + +instance Lucid.ToHtml DescriptionEditPartial where + toHtmlRaw = Lucid.toHtml + toHtml (DescriptionEditPartial tid desc isEpic) = + Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block editing"] <| do + Lucid.div_ [Lucid.class_ "description-header"] <| do + Lucid.h3_ (if isEpic then "Design" else "Description") + Lucid.button_ + [ Lucid.type_ "button", + Lucid.class_ "cancel-link", + Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"), + Lucid.makeAttribute "hx-target" "#description-block", + Lucid.makeAttribute "hx-swap" "outerHTML", + Lucid.makeAttribute "hx-confirm" "Discard changes?" + ] + "Cancel" + Lucid.form_ + [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"), + Lucid.makeAttribute "hx-target" "#description-block", + Lucid.makeAttribute "hx-swap" "outerHTML" + ] + <| do + Lucid.textarea_ + [ Lucid.name_ "description", + Lucid.class_ "description-textarea", + Lucid.rows_ (if isEpic then "15" else "10"), + Lucid.placeholder_ (if isEpic then "Enter design in Markdown..." else "Enter description...") + ] + (Lucid.toHtml desc) + Lucid.div_ [Lucid.class_ "form-actions"] <| do + Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save" + +instance Lucid.ToHtml AgentEventsPartial where + toHtmlRaw = Lucid.toHtml + toHtml (AgentEventsPartial tid events isInProgress now) = do + let nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events + eventCount = length nonCostEvents + (totalCents, totalTokens) = aggregateCostMetrics events + Lucid.h3_ <| do + Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")") + when (totalCents > 0 || totalTokens > 0) <| do + Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do + metaSep + when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents) + when (totalCents > 0 && totalTokens > 0) <| metaSep + when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens") + when isInProgress <| do + renderLiveToggle + renderAutoscrollToggle + if null nonCostEvents + then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet." + else do + Lucid.div_ [Lucid.class_ "timeline-events"] <| do + traverse_ (renderTimelineEvent now) nonCostEvents + when isInProgress <| timelineScrollScript + commentForm tid diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs new file mode 100644 index 0000000..f75b33c --- /dev/null +++ b/Omni/Jr/Web/Style.hs @@ -0,0 +1,2260 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- : dep clay +module Omni.Jr.Web.Style + ( css, + statusBadgeClass, + priorityBadgeClass, + ) +where + +import Alpha hiding (wrap, (**), (|>)) +import Clay +import qualified Clay.Flexbox as Flexbox +import qualified Clay.Media as Media +import qualified Clay.Stylesheet as Stylesheet +import qualified Data.Text.Lazy as LazyText + +css :: LazyText.Text +css = render stylesheet + +stylesheet :: Css +stylesheet = do + baseStyles + layoutStyles + navigationStyles + breadcrumbStyles + cardStyles + listGroupStyles + statusBadges + buttonStyles + formStyles + executionDetailsStyles + activityTimelineStyles + commitStyles + markdownStyles + retryBannerStyles + commentStyles + taskMetaStyles + timeFilterStyles + sortDropdownStyles + timelineEventStyles + unifiedTimelineStyles + responsiveStyles + darkModeStyles + +baseStyles :: Css +baseStyles = do + star ? boxSizing borderBox + html <> body ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 0) + body ? do + fontFamily + [ "-apple-system", + "BlinkMacSystemFont", + "Segoe UI", + "Roboto", + "Helvetica Neue", + "Arial", + "Noto Sans", + "sans-serif" + ] + [sansSerif] + fontSize (px 14) + lineHeight (em 1.3) + color "#1f2937" + backgroundColor "#f5f5f5" + minHeight (vh 100) + "h1" ? do + fontSize (px 20) + fontWeight bold + margin (px 0) (px 0) (em 0.3) (px 0) + "h2" ? do + fontSize (px 16) + fontWeight (weight 600) + color "#374151" + margin (em 1) (px 0) (em 0.5) (px 0) + "h3" ? do + fontSize (px 14) + fontWeight (weight 600) + color "#374151" + margin (em 0.75) (px 0) (em 0.25) (px 0) + a ? do + color "#0066cc" + textDecoration none + a # hover ? textDecoration underline + code ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (em 0.9) + backgroundColor "#f3f4f6" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + pre ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 8) (px 8) (px 8) (px 8) + borderRadius (px 2) (px 2) (px 2) (px 2) + overflow auto + whiteSpace preWrap + maxHeight (px 500) + +layoutStyles :: Css +layoutStyles = do + ".container" ? do + width (pct 100) + maxWidth (px 960) + margin (px 0) auto (px 0) auto + padding (px 8) (px 12) (px 8) (px 12) + main_ ? do + Stylesheet.key "flex" ("1 0 auto" :: Text) + ".page-content" ? do + padding (px 0) (px 0) (px 0) (px 0) + ".stats-grid" ? do + display grid + Stylesheet.key "grid-template-columns" ("repeat(auto-fit, minmax(80px, 1fr))" :: Text) + Stylesheet.key "gap" ("6px" :: Text) + ".task-list" ? do + display flex + flexDirection column + Stylesheet.key "gap" ("2px" :: Text) + ".detail-row" ? do + display flex + flexWrap Flexbox.wrap + padding (px 6) (px 0) (px 6) (px 0) + marginBottom (px 4) + ".detail-label" ? do + fontWeight (weight 600) + width (px 100) + color "#6b7280" + minWidth (px 80) + fontSize (px 13) + ".detail-value" ? do + Stylesheet.key "flex" ("1" :: Text) + minWidth (px 0) + ".detail-section" ? do + marginTop (em 0.75) + paddingTop (em 0.75) + borderTop (px 1) solid "#e5e7eb" + ".dep-list" <> ".child-list" ? do + margin (px 4) (px 0) (px 4) (px 0) + paddingLeft (px 16) + (".dep-list" ** li) <> (".child-list" ** li) ? margin (px 2) (px 0) (px 2) (px 0) + ".dep-type" <> ".child-status" ? do + color "#6b7280" + fontSize (px 12) + ".child-title" ? color "#374151" + ".priority-desc" ? do + color "#6b7280" + marginLeft (px 4) + +navigationStyles :: Css +navigationStyles = do + ".navbar" ? do + backgroundColor white + padding (px 6) (px 12) (px 6) (px 12) + borderBottom (px 1) solid "#d0d0d0" + marginBottom (px 8) + display flex + alignItems center + justifyContent spaceBetween + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("8px" :: Text) + ".navbar-brand" ? do + fontSize (px 18) + fontWeight bold + color "#0066cc" + textDecoration none + ".navbar-brand" # hover ? textDecoration none + ".navbar-toggle-checkbox" ? display none + ".navbar-hamburger" ? do + display none + flexDirection column + justifyContent center + alignItems center + width (px 32) + height (px 32) + cursor pointer + Stylesheet.key "gap" ("4px" :: Text) + ".hamburger-line" ? do + display block + width (px 20) + height (px 2) + backgroundColor "#374151" + borderRadius (px 1) (px 1) (px 1) (px 1) + transition "all" (ms 200) ease (sec 0) + ".navbar-links" ? do + display flex + Stylesheet.key "gap" ("2px" :: Text) + flexWrap Flexbox.wrap + alignItems center + ".navbar-link" ? do + display inlineBlock + padding (px 4) (px 10) (px 4) (px 10) + color "#374151" + textDecoration none + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 13) + fontWeight (weight 500) + transition "background-color" (ms 150) ease (sec 0) + ".navbar-link" # hover ? do + backgroundColor "#f3f4f6" + textDecoration none + ".navbar-dropdown" ? do + position relative + display inlineBlock + ".navbar-dropdown-btn" ? do + display inlineBlock + padding (px 4) (px 10) (px 4) (px 10) + color "#374151" + backgroundColor transparent + border (px 0) none transparent + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 13) + fontWeight (weight 500) + cursor pointer + transition "background-color" (ms 150) ease (sec 0) + ".navbar-dropdown-btn" # hover ? backgroundColor "#f3f4f6" + ".navbar-dropdown-content" ? do + display none + position absolute + left (px 0) + top (pct 100) + backgroundColor white + minWidth (px 120) + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text) + borderRadius (px 2) (px 2) (px 2) (px 2) + zIndex 100 + Stylesheet.key "overflow" ("hidden" :: Text) + ".navbar-dropdown" # hover |> ".navbar-dropdown-content" ? display block + ".navbar-dropdown.open" |> ".navbar-dropdown-content" ? display block + ".navbar-dropdown-item" ? do + display block + padding (px 8) (px 12) (px 8) (px 12) + color "#374151" + textDecoration none + fontSize (px 13) + transition "background-color" (ms 150) ease (sec 0) + ".navbar-dropdown-item" # hover ? do + backgroundColor "#f3f4f6" + textDecoration none + header ? do + backgroundColor white + padding (px 6) (px 12) (px 6) (px 12) + borderBottom (px 1) solid "#d0d0d0" + marginBottom (px 8) + ".nav-content" ? do + maxWidth (px 960) + margin (px 0) auto (px 0) auto + display flex + alignItems center + justifyContent spaceBetween + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("8px" :: Text) + ".nav-brand" ? do + fontSize (px 16) + fontWeight bold + color "#1f2937" + textDecoration none + ".nav-brand" # hover ? textDecoration none + ".nav-links" ? do + display flex + Stylesheet.key "gap" ("4px" :: Text) + flexWrap Flexbox.wrap + ".actions" ? do + display flex + flexDirection row + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("6px" :: Text) + marginBottom (px 8) + +breadcrumbStyles :: Css +breadcrumbStyles = do + ".breadcrumb-container" ? do + backgroundColor transparent + padding (px 6) (px 0) (px 6) (px 0) + ".breadcrumb-list" ? do + display flex + alignItems center + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("4px" :: Text) + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 0) + listStyleType none + fontSize (px 12) + ".breadcrumb-item" ? do + display flex + alignItems center + Stylesheet.key "gap" ("4px" :: Text) + ".breadcrumb-sep" ? do + color "#9ca3af" + Stylesheet.key "user-select" ("none" :: Text) + ".breadcrumb-current" ? do + color "#6b7280" + fontWeight (weight 500) + (".breadcrumb-list" ** a) ? do + color "#0066cc" + textDecoration none + (".breadcrumb-list" ** a) # hover ? textDecoration underline + +cardStyles :: Css +cardStyles = do + ".card" + <> ".task-card" + <> ".stat-card" + <> ".task-detail" + <> ".task-summary" + <> ".filter-form" + <> ".status-form" + <> ".diff-section" + <> ".review-actions" + ? do + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d0d0d0" + ".review-actions" ? do + display flex + flexDirection row + flexWrap Flexbox.wrap + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + ".stat-card" ? textAlign center + ".stat-count" ? do + fontSize (px 22) + fontWeight bold + ".stat-label" ? do + fontSize (px 11) + color "#6b7280" + marginTop (px 2) + ".stat-card.badge-open" ? do + borderLeft (px 4) solid "#f59e0b" + (".stat-card.badge-open" |> ".stat-count") ? color "#92400e" + ".stat-card.badge-inprogress" ? borderLeft (px 4) solid "#3b82f6" + (".stat-card.badge-inprogress" |> ".stat-count") ? color "#1e40af" + ".stat-card.badge-review" ? borderLeft (px 4) solid "#8b5cf6" + (".stat-card.badge-review" |> ".stat-count") ? color "#6b21a8" + ".stat-card.badge-approved" ? borderLeft (px 4) solid "#06b6d4" + (".stat-card.badge-approved" |> ".stat-count") ? color "#0e7490" + ".stat-card.badge-done" ? borderLeft (px 4) solid "#10b981" + (".stat-card.badge-done" |> ".stat-count") ? color "#065f46" + ".stat-card.badge-neutral" ? borderLeft (px 4) solid "#6b7280" + (".stat-card.badge-neutral" |> ".stat-count") ? color "#374151" + ".task-card" ? do + transition "border-color" (ms 150) ease (sec 0) + ".task-card" # hover ? do + borderColor "#999" + ".task-card-link" ? do + display block + textDecoration none + color inherit + cursor pointer + ".task-card-link" # hover ? textDecoration none + ".task-header" ? do + display flex + flexWrap Flexbox.wrap + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + marginBottom (px 4) + ".task-id" ? do + fontFamily ["SF Mono", "Monaco", "monospace"] [monospace] + color "#0066cc" + textDecoration none + fontSize (px 12) + padding (px 2) (px 0) (px 2) (px 0) + ".task-id" # hover ? textDecoration underline + ".priority" ? do + fontSize (px 11) + color "#6b7280" + ".blocking-impact" ? do + fontSize (px 10) + color "#6b7280" + backgroundColor "#e5e7eb" + padding (px 1) (px 6) (px 1) (px 6) + borderRadius (px 8) (px 8) (px 8) (px 8) + marginLeft auto + ".task-title" ? do + fontSize (px 14) + margin (px 0) (px 0) (px 0) (px 0) + ".empty-msg" ? do + color "#6b7280" + fontStyle italic + ".info-msg" ? do + color "#6b7280" + marginBottom (px 12) + ".kb-preview" ? do + color "#6b7280" + fontSize (px 12) + marginTop (px 4) + overflow hidden + Stylesheet.key "text-overflow" ("ellipsis" :: Text) + ".ready-link" ? do + fontSize (px 13) + color "#0066cc" + ".count-badge" ? do + backgroundColor "#0066cc" + color white + padding (px 2) (px 8) (px 2) (px 8) + borderRadius (px 10) (px 10) (px 10) (px 10) + fontSize (px 12) + verticalAlign middle + ".description" ? do + backgroundColor "#f9fafb" + padding (px 8) (px 8) (px 8) (px 8) + borderRadius (px 2) (px 2) (px 2) (px 2) + margin (px 0) (px 0) (px 0) (px 0) + color "#374151" + fontSize (px 13) + ".description-block" ? do + pure () + ".description-header" ? do + display flex + justifyContent spaceBetween + alignItems center + marginBottom (px 8) + (".description-header" |> "h3") ? do + margin (px 0) (px 0) (px 0) (px 0) + ".edit-link" <> ".cancel-link" ? do + fontSize (px 12) + color "#0066cc" + "button.cancel-link" ? do + color "#dc2626" + backgroundColor transparent + border (px 0) solid transparent + padding (px 0) (px 0) (px 0) (px 0) + cursor pointer + textDecoration underline + ".diff-block" ? do + maxHeight (px 600) + overflowY auto + ".progress-bar" ? do + height (px 6) + backgroundColor "#e5e7eb" + borderRadius (px 2) (px 2) (px 2) (px 2) + overflow hidden + marginTop (px 6) + ".progress-fill" ? do + height (pct 100) + backgroundColor "#0066cc" + borderRadius (px 2) (px 2) (px 2) (px 2) + transition "width" (ms 300) ease (sec 0) + ".multi-progress-container" ? do + marginBottom (px 12) + ".multi-progress-bar" ? do + display flex + height (px 8) + backgroundColor "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + overflow hidden + marginTop (px 6) + ".multi-progress-segment" ? do + height (pct 100) + transition "width" (ms 300) ease (sec 0) + ".progress-done" ? backgroundColor "#10b981" + ".progress-inprogress" ? backgroundColor "#f59e0b" + ".progress-open" ? backgroundColor "#3b82f6" + ".progress-legend" ? do + display flex + Stylesheet.key "gap" ("16px" :: Text) + marginTop (px 6) + fontSize (px 12) + color "#6b7280" + ".legend-item" ? do + display flex + alignItems center + Stylesheet.key "gap" ("4px" :: Text) + ".legend-dot" ? do + display inlineBlock + width (px 10) + height (px 10) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".legend-done" ? backgroundColor "#10b981" + ".legend-inprogress" ? backgroundColor "#f59e0b" + ".legend-open" ? backgroundColor "#3b82f6" + ".stats-section" ? do + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d0d0d0" + ".stats-row" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + padding (px 4) (px 0) (px 4) (px 0) + marginBottom (px 2) + ".stats-label" ? do + minWidth (px 80) + fontWeight (weight 500) + fontSize (px 13) + ".stats-bar-container" ? do + Stylesheet.key "flex" ("1" :: Text) + ".stats-count" ? do + minWidth (px 32) + textAlign (alignSide sideRight) + fontWeight (weight 500) + fontSize (px 13) + ".summary-section" ? do + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d0d0d0" + ".no-commit-msg" ? do + backgroundColor "#fff3cd" + border (px 1) solid "#ffc107" + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + margin (px 8) (px 0) (px 8) (px 0) + ".conflict-warning" ? do + backgroundColor "#fee2e2" + border (px 1) solid "#ef4444" + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + margin (px 8) (px 0) (px 8) (px 0) + +listGroupStyles :: Css +listGroupStyles = do + ".list-group" ? do + display flex + flexDirection column + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + border (px 1) solid "#d0d0d0" + overflow hidden + ".list-group-item" ? do + display flex + alignItems center + justifyContent spaceBetween + padding (px 8) (px 10) (px 8) (px 10) + borderBottom (px 1) solid "#e5e7eb" + textDecoration none + color inherit + transition "background-color" (ms 150) ease (sec 0) + ".list-group-item" # lastChild ? borderBottom (px 0) none transparent + ".list-group-item" # hover ? do + backgroundColor "#f9fafb" + textDecoration none + ".list-group-item-content" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + Stylesheet.key "flex" ("1" :: Text) + minWidth (px 0) + overflow hidden + ".list-group-item-id" ? do + fontFamily ["SF Mono", "Monaco", "monospace"] [monospace] + color "#0066cc" + fontSize (px 12) + flexShrink 0 + ".list-group-item-title" ? do + fontSize (px 13) + color "#374151" + overflow hidden + Stylesheet.key "text-overflow" ("ellipsis" :: Text) + whiteSpace nowrap + ".list-group-item-meta" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + flexShrink 0 + +statusBadges :: Css +statusBadges = do + ".badge" ? do + display inlineBlock + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 11) + fontWeight (weight 500) + whiteSpace nowrap + ".badge-open" ? do + backgroundColor "#fef3c7" + color "#92400e" + ".badge-inprogress" ? do + backgroundColor "#dbeafe" + color "#1e40af" + ".badge-review" ? do + backgroundColor "#ede9fe" + color "#6b21a8" + ".badge-approved" ? do + backgroundColor "#cffafe" + color "#0e7490" + ".badge-done" ? do + backgroundColor "#d1fae5" + color "#065f46" + ".badge-needshelp" ? do + backgroundColor "#fef3c7" + color "#92400e" + ".status-badge-dropdown" ? do + position relative + display inlineBlock + ".status-badge-clickable" ? do + cursor pointer + Stylesheet.key "user-select" ("none" :: Text) + ".status-badge-clickable" # hover ? do + opacity 0.85 + ".dropdown-arrow" ? do + fontSize (px 8) + marginLeft (px 2) + opacity 0.7 + ".status-dropdown-menu" ? do + display none + position absolute + left (px 0) + top (pct 100) + marginTop (px 2) + backgroundColor white + borderRadius (px 4) (px 4) (px 4) (px 4) + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text) + zIndex 100 + padding (px 4) (px 4) (px 4) (px 4) + minWidth (px 100) + ".status-badge-dropdown.open" |> ".status-dropdown-menu" ? do + display block + ".status-option-form" ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 0) + ".status-dropdown-option" ? do + display block + width (pct 100) + textAlign (alignSide sideLeft) + margin (px 2) (px 0) (px 2) (px 0) + border (px 0) none transparent + cursor pointer + transition "opacity" (ms 150) ease (sec 0) + ".status-dropdown-option" # hover ? do + opacity 0.7 + ".status-dropdown-option" # focus ? do + opacity 0.85 + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".status-dropdown-option.selected" ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".status-badge-clickable" # focus ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("2px" :: Text) + ".badge-p0" ? do + backgroundColor "#fee2e2" + color "#991b1b" + ".badge-p1" ? do + backgroundColor "#fef3c7" + color "#92400e" + ".badge-p2" ? do + backgroundColor "#dbeafe" + color "#1e40af" + ".badge-p3" ? do + backgroundColor "#e5e7eb" + color "#4b5563" + ".badge-p4" ? do + backgroundColor "#f3f4f6" + color "#6b7280" + ".priority-badge-dropdown" ? do + position relative + display inlineBlock + ".priority-badge-clickable" ? do + cursor pointer + Stylesheet.key "user-select" ("none" :: Text) + ".priority-badge-clickable" # hover ? do + opacity 0.85 + ".priority-dropdown-menu" ? do + display none + position absolute + left (px 0) + top (pct 100) + marginTop (px 2) + backgroundColor white + borderRadius (px 4) (px 4) (px 4) (px 4) + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text) + zIndex 100 + padding (px 4) (px 4) (px 4) (px 4) + minWidth (px 100) + ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do + display block + ".priority-option-form" ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 0) + ".priority-dropdown-option" ? do + display block + width (pct 100) + textAlign (alignSide sideLeft) + margin (px 2) (px 0) (px 2) (px 0) + border (px 0) none transparent + cursor pointer + transition "opacity" (ms 150) ease (sec 0) + ".priority-dropdown-option" # hover ? do + opacity 0.7 + ".priority-dropdown-option" # focus ? do + opacity 0.85 + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".priority-dropdown-option.selected" ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".priority-badge-clickable" # focus ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("2px" :: Text) + ".badge-complexity" ? do + backgroundColor "#f0f9ff" + color "#0c4a6e" + ".badge-complexity-1" ? do + backgroundColor "#f0fdf4" + color "#166534" + ".badge-complexity-2" ? do + backgroundColor "#f0f9ff" + color "#075985" + ".badge-complexity-3" ? do + backgroundColor "#fef3c7" + color "#92400e" + ".badge-complexity-4" ? do + backgroundColor "#fef3c7" + color "#b45309" + ".badge-complexity-5" ? do + backgroundColor "#fee2e2" + color "#991b1b" + ".badge-complexity-none" ? do + backgroundColor "#f3f4f6" + color "#6b7280" + ".complexity-badge-dropdown" ? do + position relative + display inlineBlock + ".complexity-badge-clickable" ? do + cursor pointer + Stylesheet.key "user-select" ("none" :: Text) + ".complexity-badge-clickable" # hover ? do + opacity 0.85 + ".complexity-dropdown-menu" ? do + display none + position absolute + left (px 0) + top (pct 100) + marginTop (px 2) + backgroundColor white + borderRadius (px 4) (px 4) (px 4) (px 4) + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text) + zIndex 100 + padding (px 4) (px 4) (px 4) (px 4) + minWidth (px 100) + ".complexity-badge-dropdown.open" |> ".complexity-dropdown-menu" ? do + display block + ".complexity-option-form" ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 0) + ".complexity-dropdown-option" ? do + display block + width (pct 100) + textAlign (alignSide sideLeft) + margin (px 2) (px 0) (px 2) (px 0) + border (px 0) none transparent + cursor pointer + transition "opacity" (ms 150) ease (sec 0) + ".complexity-dropdown-option" # hover ? do + opacity 0.7 + ".complexity-dropdown-option" # focus ? do + opacity 0.85 + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".complexity-dropdown-option.selected" ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("1px" :: Text) + ".complexity-badge-clickable" # focus ? do + Stylesheet.key "outline" ("2px solid #0066cc" :: Text) + Stylesheet.key "outline-offset" ("2px" :: Text) + +buttonStyles :: Css +buttonStyles = do + ".btn" + <> ".action-btn" + <> ".filter-btn" + <> ".submit-btn" + <> ".accept-btn" + <> ".reject-btn" + <> ".review-link-btn" + ? do + display inlineBlock + minHeight (px 32) + padding (px 6) (px 12) (px 6) (px 12) + borderRadius (px 2) (px 2) (px 2) (px 2) + border (px 0) none transparent + fontSize (px 13) + fontWeight (weight 500) + textDecoration none + cursor pointer + textAlign center + transition "all" (ms 150) ease (sec 0) + Stylesheet.key "touch-action" ("manipulation" :: Text) + ".action-btn" ? do + backgroundColor white + border (px 1) solid "#d1d5db" + color "#374151" + ".action-btn" # hover ? do + backgroundColor "#f9fafb" + borderColor "#9ca3af" + ".action-btn-primary" <> ".filter-btn" <> ".submit-btn" ? do + backgroundColor "#0066cc" + color white + borderColor "#0066cc" + ".action-btn-primary" + # hover + <> ".filter-btn" + # hover + <> ".submit-btn" + # hover + ? do + backgroundColor "#0052a3" + ".accept-btn" ? do + backgroundColor "#10b981" + color white + ".accept-btn" # hover ? backgroundColor "#059669" + ".reject-btn" ? do + backgroundColor "#ef4444" + color white + ".reject-btn" # hover ? backgroundColor "#dc2626" + ".clear-btn" ? do + display inlineBlock + minHeight (px 32) + padding (px 6) (px 10) (px 6) (px 10) + backgroundColor "#6b7280" + color white + borderRadius (px 2) (px 2) (px 2) (px 2) + textDecoration none + fontSize (px 13) + cursor pointer + ".clear-btn" # hover ? backgroundColor "#4b5563" + ".review-link-btn" ? do + backgroundColor "#8b5cf6" + color white + ".review-link-btn" # hover ? backgroundColor "#7c3aed" + ".review-link-section" ? margin (px 8) (px 0) (px 8) (px 0) + ".btn-secondary" <> ".load-more-btn" ? do + backgroundColor "#6b7280" + color white + width (pct 100) + marginTop (px 8) + ".btn-secondary" # hover <> ".load-more-btn" # hover ? backgroundColor "#4b5563" + +formStyles :: Css +formStyles = do + ".filter-row" ? do + display flex + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("8px" :: Text) + alignItems flexEnd + ".filter-group" ? do + display flex + flexDirection row + alignItems center + Stylesheet.key "gap" ("4px" :: Text) + (".filter-group" |> label) ? do + fontSize (px 12) + color "#6b7280" + fontWeight (weight 500) + whiteSpace nowrap + ".filter-select" <> ".filter-input" <> ".status-select" ? do + minHeight (px 32) + padding (px 6) (px 10) (px 6) (px 10) + border (px 1) solid "#d1d5db" + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 13) + minWidth (px 100) + ".filter-input" ? minWidth (px 120) + ".inline-form" ? display inlineBlock + ".reject-form" ? do + display flex + Stylesheet.key "gap" ("6px" :: Text) + Stylesheet.key "flex" ("1" :: Text) + minWidth (px 200) + flexWrap Flexbox.wrap + ".reject-notes" ? do + Stylesheet.key "flex" ("1" :: Text) + minWidth (px 160) + minHeight (px 32) + padding (px 6) (px 10) (px 6) (px 10) + border (px 1) solid "#d1d5db" + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 13) + Stylesheet.key "resize" ("vertical" :: Text) + ".edit-description" ? do + marginTop (px 8) + padding (px 8) (px 0) (px 0) (px 0) + borderTop (px 1) solid "#e5e7eb" + (".edit-description" |> "summary") ? do + cursor pointer + color "#0066cc" + fontSize (px 13) + fontWeight (weight 500) + (".edit-description" |> "summary") # hover ? textDecoration underline + ".description-textarea" ? do + width (pct 100) + minHeight (px 250) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d1d5db" + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 13) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + lineHeight (em 1.5) + Stylesheet.key "resize" ("vertical" :: Text) + marginTop (px 8) + ".form-actions" ? do + display flex + flexDirection row + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("8px" :: Text) + marginTop (px 8) + ".fact-edit-form" ? do + marginTop (px 8) + ".form-group" ? do + marginBottom (px 16) + (".form-group" |> label) ? do + display block + marginBottom (px 4) + fontSize (px 13) + fontWeight (weight 500) + color "#374151" + ".form-input" <> ".form-textarea" ? do + width (pct 100) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d1d5db" + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 14) + lineHeight (em 1.5) + ".form-input" # focus <> ".form-textarea" # focus ? do + borderColor "#0066cc" + Stylesheet.key "outline" ("none" :: Text) + Stylesheet.key "box-shadow" ("0 0 0 2px rgba(0, 102, 204, 0.2)" :: Text) + ".form-textarea" ? do + minHeight (px 120) + Stylesheet.key "resize" ("vertical" :: Text) + fontFamily + [ "-apple-system", + "BlinkMacSystemFont", + "Segoe UI", + "Roboto", + "Helvetica Neue", + "Arial", + "sans-serif" + ] + [sansSerif] + ".btn" ? do + display inlineBlock + padding (px 8) (px 16) (px 8) (px 16) + border (px 0) none transparent + borderRadius (px 3) (px 3) (px 3) (px 3) + fontSize (px 14) + fontWeight (weight 500) + textDecoration none + cursor pointer + transition "all" (ms 150) ease (sec 0) + ".btn-primary" ? do + backgroundColor "#0066cc" + color white + ".btn-primary" # hover ? backgroundColor "#0052a3" + ".btn-secondary" ? do + backgroundColor "#6b7280" + color white + ".btn-secondary" # hover ? backgroundColor "#4b5563" + ".btn-danger" ? do + backgroundColor "#dc2626" + color white + ".btn-danger" # hover ? backgroundColor "#b91c1c" + ".danger-zone" ? do + marginTop (px 24) + padding (px 16) (px 16) (px 16) (px 16) + backgroundColor "#fef2f2" + border (px 1) solid "#fecaca" + borderRadius (px 4) (px 4) (px 4) (px 4) + (".danger-zone" |> h2) ? do + color "#dc2626" + marginBottom (px 12) + ".back-link" ? do + marginTop (px 24) + paddingTop (px 16) + borderTop (px 1) solid "#e5e7eb" + (".back-link" |> a) ? do + color "#6b7280" + textDecoration none + (".back-link" |> a) # hover ? do + color "#374151" + textDecoration underline + ".task-link" ? do + color "#0066cc" + textDecoration none + fontWeight (weight 500) + ".task-link" # hover ? textDecoration underline + ".error-msg" ? do + color "#dc2626" + backgroundColor "#fef2f2" + padding (px 16) (px 16) (px 16) (px 16) + borderRadius (px 4) (px 4) (px 4) (px 4) + border (px 1) solid "#fecaca" + ".create-fact-section" ? do + marginBottom (px 16) + ".create-fact-toggle" ? do + cursor pointer + display inlineBlock + ".fact-create-form" ? do + marginTop (px 12) + padding (px 16) (px 16) (px 16) (px 16) + backgroundColor white + borderRadius (px 4) (px 4) (px 4) (px 4) + border (px 1) solid "#d1d5db" + +executionDetailsStyles :: Css +executionDetailsStyles = do + ".execution-section" ? do + marginTop (em 1) + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d0d0d0" + ".execution-details" ? do + marginTop (px 8) + ".metric-row" ? do + display flex + flexWrap Flexbox.wrap + padding (px 4) (px 0) (px 4) (px 0) + marginBottom (px 2) + ".metric-label" ? do + fontWeight (weight 600) + width (px 120) + color "#6b7280" + fontSize (px 13) + ".metric-value" ? do + Stylesheet.key "flex" ("1" :: Text) + fontSize (px 13) + ".amp-link" ? do + color "#0066cc" + textDecoration none + wordBreak breakAll + ".amp-link" # hover ? textDecoration underline + ".amp-thread-btn" ? do + display inlineBlock + padding (px 4) (px 10) (px 4) (px 10) + backgroundColor "#7c3aed" + color white + borderRadius (px 3) (px 3) (px 3) (px 3) + textDecoration none + fontSize (px 12) + fontWeight (weight 500) + transition "background-color" (ms 150) ease (sec 0) + ".amp-thread-btn" # hover ? do + backgroundColor "#6d28d9" + textDecoration none + ".retry-count" ? do + color "#f97316" + fontWeight (weight 600) + ".attempts-divider" ? do + margin (px 12) (px 0) (px 12) (px 0) + border (px 0) none transparent + borderTop (px 1) solid "#e5e7eb" + ".attempt-header" ? do + fontWeight (weight 600) + fontSize (px 13) + color "#374151" + marginTop (px 8) + marginBottom (px 4) + paddingBottom (px 4) + borderBottom (px 1) solid "#f3f4f6" + ".aggregated-metrics" ? do + marginTop (em 0.5) + paddingTop (em 0.75) + ".metrics-grid" ? do + display grid + Stylesheet.key "grid-template-columns" ("repeat(auto-fit, minmax(100px, 1fr))" :: Text) + Stylesheet.key "gap" ("10px" :: Text) + marginTop (px 8) + ".metric-card" ? do + backgroundColor "#f9fafb" + border (px 1) solid "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + padding (px 10) (px 12) (px 10) (px 12) + textAlign center + (".metric-card" |> ".metric-value") ? do + fontSize (px 20) + fontWeight bold + color "#374151" + display block + marginBottom (px 2) + width auto + (".metric-card" |> ".metric-label") ? do + fontSize (px 11) + color "#6b7280" + fontWeight (weight 400) + width auto + +activityTimelineStyles :: Css +activityTimelineStyles = do + ".activity-section" ? do + marginTop (em 1) + backgroundColor white + borderRadius (px 2) (px 2) (px 2) (px 2) + padding (px 8) (px 10) (px 8) (px 10) + border (px 1) solid "#d0d0d0" + ".activity-timeline" ? do + position relative + paddingLeft (px 20) + marginTop (px 8) + ".activity-timeline" # before ? do + Stylesheet.key "content" ("''" :: Text) + position absolute + left (px 6) + top (px 0) + bottom (px 0) + width (px 2) + backgroundColor "#e5e7eb" + ".activity-item" ? do + position relative + display flex + Stylesheet.key "gap" ("8px" :: Text) + paddingBottom (px 10) + marginBottom (px 0) + ".activity-item" # lastChild ? paddingBottom (px 0) + ".activity-icon" ? do + position absolute + left (px (-16)) + width (px 14) + height (px 14) + borderRadius (pct 50) (pct 50) (pct 50) (pct 50) + display flex + alignItems center + justifyContent center + fontSize (px 8) + fontWeight bold + backgroundColor white + border (px 2) solid "#e5e7eb" + ".activity-content" ? do + Stylesheet.key "flex" ("1" :: Text) + ".activity-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + marginBottom (px 2) + ".activity-stage" ? do + fontWeight (weight 600) + fontSize (px 12) + ".activity-time" ? do + fontSize (px 11) + color "#6b7280" + ".activity-message" ? do + margin (px 2) (px 0) (px 0) (px 0) + fontSize (px 12) + color "#374151" + ".activity-metadata" ? do + marginTop (px 4) + (".activity-metadata" |> "summary") ? do + fontSize (px 11) + color "#6b7280" + cursor pointer + ".metadata-json" ? do + fontSize (px 10) + backgroundColor "#f3f4f6" + padding (px 4) (px 6) (px 4) (px 6) + borderRadius (px 2) (px 2) (px 2) (px 2) + marginTop (px 2) + maxHeight (px 150) + overflow auto + ".stage-claiming" |> ".activity-icon" ? do + borderColor "#3b82f6" + color "#3b82f6" + ".stage-running" |> ".activity-icon" ? do + borderColor "#f59e0b" + color "#f59e0b" + ".stage-reviewing" |> ".activity-icon" ? do + borderColor "#8b5cf6" + color "#8b5cf6" + ".stage-retrying" |> ".activity-icon" ? do + borderColor "#f97316" + color "#f97316" + ".stage-completed" |> ".activity-icon" ? do + borderColor "#10b981" + color "#10b981" + ".stage-failed" |> ".activity-icon" ? do + borderColor "#ef4444" + color "#ef4444" + +commitStyles :: Css +commitStyles = do + ".commit-list" ? do + display flex + flexDirection column + Stylesheet.key "gap" ("4px" :: Text) + marginTop (px 8) + ".commit-item" ? do + padding (px 6) (px 8) (px 6) (px 8) + backgroundColor "#f9fafb" + borderRadius (px 2) (px 2) (px 2) (px 2) + border (px 1) solid "#e5e7eb" + ".commit-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + marginBottom (px 2) + ".commit-hash" ? do + fontFamily ["SF Mono", "Monaco", "monospace"] [monospace] + fontSize (px 12) + color "#0066cc" + textDecoration none + backgroundColor "#e5e7eb" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".commit-hash" # hover ? textDecoration underline + ".commit-summary" ? do + fontSize (px 13) + color "#374151" + fontWeight (weight 500) + ".commit-meta" ? do + display flex + Stylesheet.key "gap" ("12px" :: Text) + fontSize (px 11) + color "#6b7280" + ".commit-author" ? fontWeight (weight 500) + ".commit-files" ? do + color "#9ca3af" + +markdownStyles :: Css +markdownStyles = do + ".markdown-content" ? do + width (pct 100) + lineHeight (em 1.6) + fontSize (px 14) + color "#374151" + ".md-h1" ? do + fontSize (px 18) + fontWeight bold + margin (em 1) (px 0) (em 0.5) (px 0) + paddingBottom (em 0.3) + borderBottom (px 1) solid "#e5e7eb" + ".md-h2" ? do + fontSize (px 16) + fontWeight (weight 600) + margin (em 0.8) (px 0) (em 0.4) (px 0) + ".md-h3" ? do + fontSize (px 14) + fontWeight (weight 600) + margin (em 0.6) (px 0) (em 0.3) (px 0) + ".md-para" ? do + margin (em 0.5) (px 0) (em 0.5) (px 0) + ".md-code" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + backgroundColor "#f8f8f8" + color "#333333" + padding (px 10) (px 12) (px 10) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + border (px 1) solid "#e1e4e8" + overflow auto + whiteSpace preWrap + margin (em 0.5) (px 0) (em 0.5) (px 0) + ".md-list" ? do + margin (em 0.5) (px 0) (em 0.5) (px 0) + paddingLeft (px 24) + (".md-list" ** li) ? do + margin (px 4) (px 0) (px 4) (px 0) + ".md-inline-code" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (em 0.9) + backgroundColor "#f3f4f6" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + +retryBannerStyles :: Css +retryBannerStyles = do + ".retry-banner" ? do + borderRadius (px 4) (px 4) (px 4) (px 4) + padding (px 12) (px 16) (px 12) (px 16) + margin (px 0) (px 0) (px 16) (px 0) + ".retry-banner-warning" ? do + backgroundColor "#fef3c7" + border (px 1) solid "#f59e0b" + ".retry-banner-critical" ? do + backgroundColor "#fee2e2" + border (px 1) solid "#ef4444" + ".retry-banner-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + marginBottom (px 8) + ".retry-icon" ? do + fontSize (px 18) + fontWeight bold + ".retry-attempt" ? do + fontSize (px 14) + fontWeight (weight 600) + color "#374151" + ".retry-warning-badge" ? do + backgroundColor "#dc2626" + color white + fontSize (px 11) + fontWeight (weight 600) + padding (px 2) (px 8) (px 2) (px 8) + borderRadius (px 2) (px 2) (px 2) (px 2) + marginLeft auto + ".retry-banner-details" ? do + fontSize (px 13) + color "#374151" + ".retry-detail-row" ? do + display flex + alignItems flexStart + Stylesheet.key "gap" ("8px" :: Text) + margin (px 4) (px 0) (px 4) (px 0) + ".retry-label" ? do + fontWeight (weight 500) + minWidth (px 110) + flexShrink 0 + ".retry-value" ? do + color "#4b5563" + ".retry-commit" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (em 0.9) + backgroundColor "#f3f4f6" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".retry-conflict-list" ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 0) (px 0) (px 0) (px 16) + (".retry-conflict-list" ** li) ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + margin (px 2) (px 0) (px 2) (px 0) + ".retry-warning-message" ? do + marginTop (px 12) + padding (px 10) (px 12) (px 10) (px 12) + backgroundColor "#fecaca" + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 12) + color "#991b1b" + fontWeight (weight 500) + ".retry-hint" ? do + marginTop (px 8) + fontSize (px 12) + color "#6b7280" + fontStyle italic + +commentStyles :: Css +commentStyles = do + ".comments-section" ? do + marginTop (px 12) + ".comment-card" ? do + backgroundColor "#f9fafb" + border (px 1) solid "#e5e7eb" + borderRadius (px 4) (px 4) (px 4) (px 4) + padding (px 10) (px 12) (px 10) (px 12) + marginBottom (px 8) + ".comment-text" ? do + margin (px 0) (px 0) (px 6) (px 0) + fontSize (px 13) + color "#374151" + whiteSpace preWrap + ".comment-meta" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + ".comment-author" ? do + display inlineBlock + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 2) (px 2) (px 2) (px 2) + fontSize (px 10) + fontWeight (weight 600) + textTransform uppercase + whiteSpace nowrap + ".author-human" ? do + backgroundColor "#dbeafe" + color "#1e40af" + ".author-junior" ? do + backgroundColor "#d1fae5" + color "#065f46" + ".comment-time" ? do + fontSize (px 11) + color "#9ca3af" + ".comment-form" ? do + marginTop (px 12) + display flex + flexDirection column + Stylesheet.key "gap" ("8px" :: Text) + ".comment-textarea" ? do + width (pct 100) + padding (px 8) (px 10) (px 8) (px 10) + fontSize (px 13) + border (px 1) solid "#d0d0d0" + borderRadius (px 4) (px 4) (px 4) (px 4) + Stylesheet.key "resize" ("vertical" :: Text) + minHeight (px 60) + ".comment-textarea" # focus ? do + Stylesheet.key "outline" ("none" :: Text) + borderColor "#0066cc" + +timeFilterStyles :: Css +timeFilterStyles = do + ".time-filter" ? do + display flex + Stylesheet.key "gap" ("6px" :: Text) + marginBottom (px 12) + flexWrap Flexbox.wrap + ".time-filter-btn" ? do + display inlineBlock + padding (px 4) (px 12) (px 4) (px 12) + fontSize (px 12) + fontWeight (weight 500) + textDecoration none + borderRadius (px 12) (px 12) (px 12) (px 12) + border (px 1) solid "#d0d0d0" + backgroundColor white + color "#374151" + transition "all" (ms 150) ease (sec 0) + cursor pointer + ".time-filter-btn" # hover ? do + borderColor "#999" + backgroundColor "#f3f4f6" + textDecoration none + ".time-filter-btn.active" ? do + backgroundColor "#0066cc" + borderColor "#0066cc" + color white + ".time-filter-btn.active" # hover ? do + backgroundColor "#0055aa" + borderColor "#0055aa" + +sortDropdownStyles :: Css +sortDropdownStyles = do + ".page-header-row" ? do + display flex + alignItems center + justifyContent spaceBetween + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("12px" :: Text) + marginBottom (px 8) + ".page-header-row" |> "h1" ? do + margin (px 0) (px 0) (px 0) (px 0) + ".sort-dropdown" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 13) + ".sort-label" ? do + color "#6b7280" + fontWeight (weight 500) + ".sort-dropdown-wrapper" ? do + position relative + ".sort-dropdown-btn" ? do + padding (px 4) (px 10) (px 4) (px 10) + fontSize (px 13) + fontWeight (weight 500) + border (px 1) solid "#d0d0d0" + borderRadius (px 4) (px 4) (px 4) (px 4) + backgroundColor white + color "#374151" + cursor pointer + transition "all" (ms 150) ease (sec 0) + whiteSpace nowrap + ".sort-dropdown-btn" # hover ? do + borderColor "#999" + backgroundColor "#f3f4f6" + ".sort-dropdown-content" ? do + minWidth (px 160) + right (px 0) + left auto + ".sort-dropdown-item" ? do + padding (px 8) (px 12) (px 8) (px 12) + fontSize (px 13) + ".sort-dropdown-item.active" ? do + backgroundColor "#e0f2fe" + fontWeight (weight 600) + +taskMetaStyles :: Css +taskMetaStyles = do + ".task-meta" ? do + marginBottom (px 12) + ".task-meta-primary" ? do + display flex + alignItems center + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 14) + marginBottom (px 4) + ".task-meta-secondary" ? do + display flex + alignItems center + flexWrap Flexbox.wrap + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 12) + color "#6b7280" + ".task-meta-id" ? do + fontFamily ["SF Mono", "Monaco", "monospace"] [monospace] + fontSize (px 13) + backgroundColor "#f3f4f6" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".task-meta-label" ? do + color "#6b7280" + ".meta-sep" ? do + color "#d1d5db" + Stylesheet.key "user-select" ("none" :: Text) + +timelineEventStyles :: Css +timelineEventStyles = do + ".event-header" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + marginBottom (px 4) + ".event-icon" ? do + fontSize (px 14) + width (px 20) + textAlign center + ".event-label" ? do + fontWeight (weight 500) + color "#374151" + ".event-assistant" ? do + padding (px 0) (px 0) (px 0) (px 0) + ".event-bubble" ? do + backgroundColor "#f3f4f6" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 8) (px 8) (px 8) (px 8) + whiteSpace preWrap + lineHeight (em 1.5) + ".event-truncated" ? do + color "#6b7280" + fontStyle italic + ".event-tool-call" ? do + borderLeft (px 3) solid "#3b82f6" + paddingLeft (px 8) + ".event-tool-call" |> "summary" ? do + cursor pointer + listStyleType none + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + ".event-tool-call" |> "summary" # before ? do + content (stringContent "▶") + fontSize (px 10) + color "#6b7280" + transition "transform" (ms 150) ease (sec 0) + ".event-tool-call[open]" |> "summary" # before ? do + Stylesheet.key "transform" ("rotate(90deg)" :: Text) + ".tool-name" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + color "#3b82f6" + ".tool-summary" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + color "#6b7280" + marginLeft (px 8) + ".tool-args" ? do + marginTop (px 4) + paddingLeft (px 20) + ".tool-output-pre" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 11) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 8) (px 10) (px 8) (px 10) + borderRadius (px 4) (px 4) (px 4) (px 4) + overflowX auto + whiteSpace preWrap + maxHeight (px 300) + margin (px 0) (px 0) (px 0) (px 0) + ".event-tool-result" ? do + borderLeft (px 3) solid "#10b981" + paddingLeft (px 8) + ".result-header" ? do + fontSize (px 12) + ".line-count" ? do + fontSize (px 11) + color "#6b7280" + backgroundColor "#f3f4f6" + padding (px 1) (px 6) (px 1) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + ".result-collapsible" |> "summary" ? do + cursor pointer + fontSize (px 12) + color "#0066cc" + marginBottom (px 4) + ".result-collapsible" |> "summary" # hover ? textDecoration underline + ".tool-output" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 11) + backgroundColor "#1e1e1e" + color "#d4d4d4" + padding (px 8) (px 10) (px 8) (px 10) + borderRadius (px 4) (px 4) (px 4) (px 4) + overflowX auto + whiteSpace preWrap + maxHeight (px 300) + margin (px 0) (px 0) (px 0) (px 0) + ".event-cost" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 11) + color "#6b7280" + padding (px 4) (px 0) (px 4) (px 0) + ".cost-text" ? do + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + ".event-error" ? do + borderLeft (px 3) solid "#ef4444" + paddingLeft (px 8) + backgroundColor "#fef2f2" + padding (px 8) (px 8) (px 8) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + ".event-error" |> ".event-label" ? color "#dc2626" + ".error-message" ? do + color "#dc2626" + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + whiteSpace preWrap + ".event-complete" ? do + display flex + alignItems center + Stylesheet.key "gap" ("8px" :: Text) + color "#10b981" + fontWeight (weight 500) + padding (px 8) (px 0) (px 8) (px 0) + ".output-collapsible" |> "summary" ? do + cursor pointer + fontSize (px 12) + color "#0066cc" + marginBottom (px 4) + ".output-collapsible" |> "summary" # hover ? textDecoration underline + Stylesheet.key "@keyframes pulse" ("0%, 100% { opacity: 1; } 50% { opacity: 0.5; }" :: Text) + +unifiedTimelineStyles :: Css +unifiedTimelineStyles = do + ".unified-timeline-section" ? do + marginTop (em 1.5) + paddingTop (em 1) + borderTop (px 1) solid "#e5e7eb" + ".timeline-live-toggle" ? do + fontSize (px 10) + fontWeight bold + color "#10b981" + backgroundColor "#d1fae5" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + marginLeft (px 8) + textTransform uppercase + border (px 1) solid "#6ee7b7" + cursor pointer + Stylesheet.key "transition" ("all 0.3s ease" :: Text) + Stylesheet.key "animation" ("pulse 2s infinite" :: Text) + ".timeline-live-toggle:hover" ? do + Stylesheet.key "box-shadow" ("0 0 8px rgba(16,185,129,0.4)" :: Text) + ".timeline-live-toggle.timeline-live-paused" ? do + color "#6b7280" + backgroundColor "#f3f4f6" + border (px 1) solid "#d1d5db" + Stylesheet.key "animation" ("none" :: Text) + ".timeline-autoscroll-toggle" ? do + fontSize (px 10) + fontWeight bold + color "#3b82f6" + backgroundColor "#dbeafe" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + marginLeft (px 4) + border (px 1) solid "#93c5fd" + cursor pointer + Stylesheet.key "transition" ("all 0.2s ease" :: Text) + ".timeline-autoscroll-toggle:hover" ? do + Stylesheet.key "box-shadow" ("0 0 6px rgba(59,130,246,0.3)" :: Text) + ".timeline-autoscroll-toggle.timeline-autoscroll-disabled" ? do + color "#6b7280" + backgroundColor "#f3f4f6" + border (px 1) solid "#d1d5db" + ".timeline-live" ? do + fontSize (px 10) + fontWeight bold + color "#10b981" + backgroundColor "#d1fae5" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 10) (px 10) (px 10) (px 10) + marginLeft (px 8) + textTransform uppercase + Stylesheet.key "animation" ("pulse 2s infinite" :: Text) + ".timeline-events" ? do + maxHeight (px 600) + overflowY auto + display flex + flexDirection column + Stylesheet.key "gap" ("12px" :: Text) + padding (px 12) (px 0) (px 12) (px 0) + ".timeline-event" ? do + fontSize (px 13) + lineHeight (em 1.4) + ".actor-label" ? do + fontSize (px 11) + fontWeight (weight 500) + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 3) (px 3) (px 3) (px 3) + marginLeft (px 4) + marginRight (px 4) + ".actor-human" ? do + color "#7c3aed" + backgroundColor "#f3e8ff" + ".actor-junior" ? do + color "#0369a1" + backgroundColor "#e0f2fe" + ".actor-system" ? do + color "#6b7280" + backgroundColor "#f3f4f6" + ".timeline-comment" ? do + paddingLeft (px 4) + ".timeline-comment" |> ".comment-bubble" ? do + backgroundColor "#f3f4f6" + color "#1f2937" + padding (px 10) (px 14) (px 10) (px 14) + borderRadius (px 8) (px 8) (px 8) (px 8) + whiteSpace preWrap + marginTop (px 6) + ".timeline-status-change" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + flexWrap Flexbox.wrap + padding (px 6) (px 8) (px 6) (px 8) + backgroundColor "#f0fdf4" + borderRadius (px 6) (px 6) (px 6) (px 6) + borderLeft (px 3) solid "#22c55e" + ".status-change-text" ? do + fontWeight (weight 500) + color "#166534" + ".timeline-activity" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + flexWrap Flexbox.wrap + padding (px 4) (px 0) (px 4) (px 0) + color "#6b7280" + ".activity-detail" ? do + fontSize (px 11) + color "#9ca3af" + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + ".timeline-error" ? do + borderLeft (px 3) solid "#ef4444" + backgroundColor "#fef2f2" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + ".timeline-error" |> ".error-message" ? do + marginTop (px 6) + color "#dc2626" + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + whiteSpace preWrap + ".timeline-thought" ? do + paddingLeft (px 4) + ".timeline-thought" |> ".thought-bubble" ? do + backgroundColor "#fef3c7" + color "#78350f" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 8) (px 8) (px 8) (px 8) + whiteSpace preWrap + marginTop (px 6) + fontSize (px 12) + lineHeight (em 1.5) + ".timeline-tool-call" ? do + borderLeft (px 3) solid "#3b82f6" + paddingLeft (px 8) + ".timeline-tool-call" |> "summary" ? do + cursor pointer + listStyleType none + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + ".timeline-tool-call" |> "summary" # before ? do + content (stringContent "▶") + fontSize (px 10) + color "#6b7280" + transition "transform" (ms 150) ease (sec 0) + ".timeline-tool-call[open]" |> "summary" # before ? do + Stylesheet.key "transform" ("rotate(90deg)" :: Text) + ".timeline-tool-result" ? do + borderLeft (px 3) solid "#10b981" + paddingLeft (px 8) + ".timeline-tool-result" |> "summary" ? do + cursor pointer + listStyleType none + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + ".timeline-cost" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontSize (px 11) + color "#6b7280" + padding (px 2) (px 0) (px 2) (px 0) + ".timeline-checkpoint" ? do + borderLeft (px 3) solid "#8b5cf6" + backgroundColor "#faf5ff" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + ".timeline-checkpoint" |> ".checkpoint-content" ? do + marginTop (px 6) + fontSize (px 12) + whiteSpace preWrap + ".timeline-guardrail" ? do + borderLeft (px 3) solid "#f59e0b" + backgroundColor "#fffbeb" + padding (px 8) (px 12) (px 8) (px 12) + borderRadius (px 4) (px 4) (px 4) (px 4) + ".timeline-guardrail" |> ".guardrail-content" ? do + marginTop (px 6) + fontSize (px 12) + color "#92400e" + ".timeline-generic" ? do + padding (px 4) (px 0) (px 4) (px 0) + color "#6b7280" + ".formatted-json" ? do + margin (px 0) (px 0) (px 0) (px 0) + padding (px 8) (px 8) (px 8) (px 8) + backgroundColor "#f9fafb" + borderRadius (px 4) (px 4) (px 4) (px 4) + overflowX auto + fontSize (px 12) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + whiteSpace preWrap + overflowWrap breakWord + compactToolStyles + +compactToolStyles :: Css +compactToolStyles = do + ".tool-compact" ? do + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + padding (px 2) (px 0) (px 2) (px 0) + ".tool-check" ? do + color "#10b981" + fontWeight bold + ".tool-label" ? do + color "#6b7280" + fontWeight (weight 500) + ".tool-path" ? do + color "#3b82f6" + ".tool-pattern" ? do + color "#8b5cf6" + backgroundColor "#f5f3ff" + padding (px 1) (px 4) (px 1) (px 4) + borderRadius (px 2) (px 2) (px 2) (px 2) + ".tool-path-suffix" ? do + color "#6b7280" + fontSize (px 11) + ".tool-bash" ? do + display flex + alignItems flexStart + Stylesheet.key "gap" ("6px" :: Text) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + fontSize (px 12) + padding (px 2) (px 0) (px 2) (px 0) + ".tool-bash-prompt" ? do + color "#f59e0b" + fontWeight bold + fontSize (px 14) + ".tool-bash-cmd" ? do + color "#374151" + backgroundColor "#f3f4f6" + padding (px 2) (px 6) (px 2) (px 6) + borderRadius (px 3) (px 3) (px 3) (px 3) + wordBreak breakAll + ".tool-generic" ? do + fontSize (px 12) + fontFamily ["SF Mono", "Monaco", "Consolas", "monospace"] [monospace] + ".tool-generic" |> "summary" ? do + cursor pointer + display flex + alignItems center + Stylesheet.key "gap" ("6px" :: Text) + ".tool-args-pre" ? do + margin (px 4) (px 0) (px 0) (px 16) + padding (px 6) (px 8) (px 6) (px 8) + backgroundColor "#f9fafb" + borderRadius (px 3) (px 3) (px 3) (px 3) + fontSize (px 11) + whiteSpace preWrap + maxHeight (px 200) + overflowY auto + ".tool-result-output" ? do + marginLeft (px 16) + marginTop (px 2) + +responsiveStyles :: Css +responsiveStyles = do + query Media.screen [Media.maxWidth (px 600)] <| do + body ? fontSize (px 13) + ".container" ? padding (px 6) (px 8) (px 6) (px 8) + ".navbar" ? do + padding (px 6) (px 8) (px 6) (px 8) + flexWrap Flexbox.wrap + ".navbar-hamburger" ? do + display flex + Stylesheet.key "order" ("2" :: Text) + ".navbar-links" ? do + display none + width (pct 100) + Stylesheet.key "order" ("3" :: Text) + flexDirection column + alignItems flexStart + paddingTop (px 8) + Stylesheet.key "gap" ("0" :: Text) + ".navbar-toggle-checkbox" # checked |+ ".navbar-hamburger" |+ ".navbar-links" ? do + display flex + ".navbar-link" ? do + padding (px 8) (px 6) (px 8) (px 6) + fontSize (px 13) + width (pct 100) + ".navbar-dropdown" ? do + width (pct 100) + ".navbar-dropdown-btn" ? do + padding (px 8) (px 6) (px 8) (px 6) + fontSize (px 13) + width (pct 100) + textAlign (alignSide sideLeft) + ".navbar-dropdown-content" ? do + position static + Stylesheet.key "box-shadow" ("none" :: Text) + paddingLeft (px 12) + backgroundColor transparent + ".navbar-dropdown-item" ? do + padding (px 6) (px 10) (px 6) (px 10) + fontSize (px 12) + ".nav-content" ? do + flexDirection column + alignItems flexStart + ".stats-grid" ? do + Stylesheet.key "grid-template-columns" ("repeat(2, 1fr)" :: Text) + ".detail-row" ? do + flexDirection column + Stylesheet.key "gap" ("2px" :: Text) + ".detail-label" ? width auto + ".filter-row" ? do + flexWrap Flexbox.wrap + ".filter-group" ? do + width auto + flexWrap Flexbox.nowrap + ".filter-select" <> ".filter-input" ? minWidth (px 80) + ".review-actions" ? do + flexDirection column + ".reject-form" ? do + width (pct 100) + flexDirection column + ".reject-notes" ? width (pct 100) + ".actions" ? flexDirection column + ".action-btn" ? width (pct 100) + +darkModeStyles :: Css +darkModeStyles = + query Media.screen [prefersDark] <| do + body ? do + backgroundColor "#111827" + color "#f3f4f6" + ".card" + <> ".task-card" + <> ".stat-card" + <> ".task-detail" + <> ".task-summary" + <> ".filter-form" + <> ".status-form" + <> ".diff-section" + <> ".review-actions" + <> ".list-group" + ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".list-group-item" ? borderBottomColor "#374151" + ".list-group-item" # hover ? backgroundColor "#374151" + ".list-group-item-id" ? color "#60a5fa" + ".list-group-item-title" ? color "#d1d5db" + header ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".navbar" ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".navbar-brand" ? color "#60a5fa" + ".navbar-link" ? color "#d1d5db" + ".navbar-link" # hover ? backgroundColor "#374151" + ".navbar-dropdown-btn" ? color "#d1d5db" + ".navbar-dropdown-btn" # hover ? backgroundColor "#374151" + ".navbar-dropdown-content" ? do + backgroundColor "#1f2937" + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text) + ".navbar-dropdown-item" ? color "#d1d5db" + ".navbar-dropdown-item" # hover ? backgroundColor "#374151" + ".status-dropdown-menu" ? do + backgroundColor "#1f2937" + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text) + ".hamburger-line" ? backgroundColor "#d1d5db" + ".nav-brand" ? color "#f3f4f6" + "h2" <> "h3" ? color "#d1d5db" + a ? color "#60a5fa" + ".breadcrumb-container" ? backgroundColor transparent + ".breadcrumb-sep" ? color "#6b7280" + ".breadcrumb-current" ? color "#9ca3af" + + ".detail-label" + <> ".priority" + <> ".dep-type" + <> ".child-status" + <> ".empty-msg" + <> ".stat-label" + <> ".priority-desc" + ? color "#9ca3af" + ".child-title" ? color "#d1d5db" + code ? do + backgroundColor "#374151" + color "#f3f4f6" + ".task-meta-id" ? do + backgroundColor "#374151" + color "#e5e7eb" + ".task-meta-secondary" ? color "#9ca3af" + ".meta-sep" ? color "#4b5563" + ".task-meta-label" ? color "#9ca3af" + ".detail-section" ? borderTopColor "#374151" + ".description" ? do + backgroundColor "#374151" + color "#e5e7eb" + ".badge-open" ? do + backgroundColor "#78350f" + color "#fcd34d" + ".badge-inprogress" ? do + backgroundColor "#1e3a8a" + color "#93c5fd" + ".badge-review" ? do + backgroundColor "#4c1d95" + color "#c4b5fd" + ".badge-approved" ? do + backgroundColor "#164e63" + color "#67e8f9" + ".badge-done" ? do + backgroundColor "#064e3b" + color "#6ee7b7" + ".badge-needshelp" ? do + backgroundColor "#78350f" + color "#fcd34d" + ".badge-p0" ? do + backgroundColor "#7f1d1d" + color "#fca5a5" + ".badge-p1" ? do + backgroundColor "#78350f" + color "#fcd34d" + ".badge-p2" ? do + backgroundColor "#1e3a8a" + color "#93c5fd" + ".badge-p3" ? do + backgroundColor "#374151" + color "#d1d5db" + ".badge-p4" ? do + backgroundColor "#1f2937" + color "#9ca3af" + ".blocking-impact" ? do + backgroundColor "#374151" + color "#9ca3af" + ".priority-dropdown-menu" ? do + backgroundColor "#1f2937" + Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.3)" :: Text) + ".action-btn" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" + ".action-btn" # hover ? backgroundColor "#4b5563" + ".filter-select" <> ".filter-input" <> ".status-select" <> ".reject-notes" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" + ".stats-section" <> ".summary-section" ? do + backgroundColor "#1f2937" + borderColor "#374151" + + (".stat-card.badge-open" |> ".stat-count") ? color "#fbbf24" + (".stat-card.badge-inprogress" |> ".stat-count") ? color "#60a5fa" + (".stat-card.badge-review" |> ".stat-count") ? color "#a78bfa" + (".stat-card.badge-approved" |> ".stat-count") ? color "#22d3ee" + (".stat-card.badge-done" |> ".stat-count") ? color "#34d399" + (".stat-card.badge-neutral" |> ".stat-count") ? color "#9ca3af" + + ".progress-bar" ? backgroundColor "#374151" + ".progress-fill" ? backgroundColor "#60a5fa" + ".multi-progress-bar" ? backgroundColor "#374151" + ".progress-legend" ? color "#9ca3af" + ".activity-section" ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".activity-timeline" # before ? backgroundColor "#374151" + ".activity-icon" ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".activity-time" ? color "#9ca3af" + ".activity-message" ? color "#d1d5db" + (".activity-metadata" |> "summary") ? color "#9ca3af" + ".metadata-json" ? backgroundColor "#374151" + ".execution-section" ? do + backgroundColor "#1f2937" + borderColor "#374151" + + ".metric-label" ? color "#9ca3af" + ".metric-value" ? color "#d1d5db" + ".metric-card" ? do + backgroundColor "#374151" + borderColor "#4b5563" + (".metric-card" |> ".metric-value") ? color "#f3f4f6" + (".metric-card" |> ".metric-label") ? color "#9ca3af" + ".amp-link" ? color "#60a5fa" + ".amp-thread-btn" ? do + backgroundColor "#8b5cf6" + ".amp-thread-btn" # hover ? backgroundColor "#7c3aed" + ".markdown-content" ? color "#d1d5db" + ".commit-item" ? do + backgroundColor "#374151" + borderColor "#4b5563" + ".commit-hash" ? do + backgroundColor "#4b5563" + color "#60a5fa" + ".commit-summary" ? color "#d1d5db" + ".commit-meta" ? color "#9ca3af" + ".md-h1" ? borderBottomColor "#374151" + ".md-code" ? do + backgroundColor "#1e1e1e" + color "#d4d4d4" + borderColor "#374151" + ".md-inline-code" ? do + backgroundColor "#374151" + color "#f3f4f6" + ".edit-description" ? borderTopColor "#374151" + (".edit-description" |> "summary") ? color "#60a5fa" + ".edit-link" ? color "#60a5fa" + "button.cancel-link" ? do + color "#f87171" + backgroundColor transparent + border (px 0) solid transparent + ".description-textarea" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" + ".fact-create-form" ? do + backgroundColor "#1f2937" + borderColor "#374151" + ".time-filter-btn" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#d1d5db" + ".time-filter-btn" # hover ? do + backgroundColor "#4b5563" + borderColor "#6b7280" + ".time-filter-btn.active" ? do + backgroundColor "#3b82f6" + borderColor "#3b82f6" + color white + ".time-filter-btn.active" # hover ? do + backgroundColor "#2563eb" + borderColor "#2563eb" + ".sort-label" ? color "#9ca3af" + ".sort-dropdown-btn" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#d1d5db" + ".sort-dropdown-btn" # hover ? do + backgroundColor "#4b5563" + borderColor "#6b7280" + ".sort-dropdown-item.active" ? do + backgroundColor "#1e3a5f" + ".comment-card" ? do + backgroundColor "#374151" + borderColor "#4b5563" + ".comment-text" ? color "#d1d5db" + ".author-human" ? do + backgroundColor "#1e3a8a" + color "#93c5fd" + ".author-junior" ? do + backgroundColor "#064e3b" + color "#6ee7b7" + ".comment-time" ? color "#9ca3af" + ".comment-textarea" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" + ".form-input" <> ".form-textarea" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#f3f4f6" + (".form-group" |> label) ? color "#d1d5db" + ".danger-zone" ? do + backgroundColor "#450a0a" + borderColor "#991b1b" + (".danger-zone" |> h2) ? color "#f87171" + ".retry-banner-warning" ? do + backgroundColor "#451a03" + borderColor "#b45309" + ".retry-banner-critical" ? do + backgroundColor "#450a0a" + borderColor "#dc2626" + ".retry-attempt" ? color "#d1d5db" + ".retry-banner-details" ? color "#d1d5db" + ".retry-value" ? color "#9ca3af" + ".retry-commit" ? backgroundColor "#374151" + ".event-bubble" ? backgroundColor "#374151" + ".comment-bubble" ? do + backgroundColor "#374151" + color "#d1d5db" + ".thought-bubble" ? do + backgroundColor "#292524" + color "#a8a29e" + borderRadius (px 2) (px 2) (px 2) (px 2) + ".event-label" ? color "#d1d5db" + ".tool-bash-cmd" ? do + backgroundColor "#292524" + color "#a8a29e" + ".tool-label" ? color "#9ca3af" + ".tool-path" ? color "#60a5fa" + ".tool-pattern" ? do + backgroundColor "#3b2f5e" + color "#c4b5fd" + ".output-collapsible" |> "summary" ? color "#60a5fa" + ".timeline-tool-call" |> "summary" # before ? color "#9ca3af" + ".line-count" ? do + backgroundColor "#374151" + color "#9ca3af" + ".event-error" ? do + backgroundColor "#450a0a" + borderColor "#dc2626" + ".event-error" |> ".event-label" ? color "#f87171" + ".error-message" ? color "#f87171" + ".timeline-error" |> ".event-label" ? color "#fca5a5" + ".timeline-guardrail" |> ".event-label" ? color "#fbbf24" + ".timeline-guardrail" ? do + backgroundColor "#451a03" + borderColor "#f59e0b" + ".timeline-guardrail" |> ".guardrail-content" ? color "#fcd34d" + ".formatted-json" ? do + backgroundColor "#1e1e1e" + color "#d4d4d4" + -- Responsive dark mode: dropdown content needs background on mobile + query Media.screen [Media.maxWidth (px 600)] <| do + ".navbar-dropdown-content" ? do + backgroundColor "#1f2937" + ".navbar-dropdown-item" # hover ? do + backgroundColor "#374151" + +prefersDark :: Stylesheet.Feature +prefersDark = + Stylesheet.Feature "prefers-color-scheme" (Just (Clay.value ("dark" :: Text))) + +statusBadgeClass :: Text -> Text +statusBadgeClass status = case status of + "Open" -> "badge badge-open" + "InProgress" -> "badge badge-inprogress" + "Review" -> "badge badge-review" + "Approved" -> "badge badge-approved" + "Done" -> "badge badge-done" + _ -> "badge" + +priorityBadgeClass :: Text -> Text +priorityBadgeClass priority = case priority of + "P0" -> "badge badge-p0" + "P1" -> "badge badge-p1" + "P2" -> "badge badge-p2" + "P3" -> "badge badge-p3" + "P4" -> "badge badge-p4" + _ -> "badge" diff --git a/Omni/Jr/Web/Types.hs b/Omni/Jr/Web/Types.hs new file mode 100644 index 0000000..93c8d85 --- /dev/null +++ b/Omni/Jr/Web/Types.hs @@ -0,0 +1,365 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- : dep servant-server +-- : dep lucid +-- : dep http-api-data +-- : dep aeson +module Omni.Jr.Web.Types + ( TaskFilters (..), + TimeRange (..), + SortOrder (..), + parseSortOrder, + sortOrderToParam, + sortOrderLabel, + sortTasks, + parseTimeRange, + timeRangeToParam, + getTimeRangeStart, + startOfDay, + startOfWeek, + addDays, + fromGregorian, + daysSinceEpoch, + startOfMonth, + computeMetricsFromActivities, + HomePage (..), + ReadyQueuePage (..), + BlockedPage (..), + InterventionPage (..), + TaskListPage (..), + TaskDetailPage (..), + GitCommit (..), + TaskReviewPage (..), + ReviewInfo (..), + TaskDiffPage (..), + StatsPage (..), + KBPage (..), + FactDetailPage (..), + EpicsPage (..), + RecentActivityNewPartial (..), + RecentActivityMorePartial (..), + ReadyCountPartial (..), + StatusBadgePartial (..), + PriorityBadgePartial (..), + ComplexityBadgePartial (..), + TaskListPartial (..), + TaskMetricsPartial (..), + AgentEventsPartial (..), + DescriptionViewPartial (..), + DescriptionEditPartial (..), + FactEditForm (..), + FactCreateForm (..), + RejectForm (..), + StatusForm (..), + PriorityForm (..), + ComplexityForm (..), + DescriptionForm (..), + NotesForm (..), + CommentForm (..), + Breadcrumb (..), + Breadcrumbs, + CSS, + SSE, + ) +where + +import Alpha +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LazyText +import qualified Data.Text.Lazy.Encoding as LazyText +import Data.Time (Day, DayOfWeek (..), UTCTime (..), dayOfWeek, diffUTCTime, toGregorian) +import qualified Omni.Task.Core as TaskCore +import Servant (Accept (..), MimeRender (..)) +import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique) + +data TaskFilters = TaskFilters + { filterStatus :: Maybe TaskCore.Status, + filterPriority :: Maybe TaskCore.Priority, + filterNamespace :: Maybe Text, + filterType :: Maybe TaskCore.TaskType + } + deriving (Show, Eq) + +data TimeRange = Today | Week | Month | AllTime + deriving (Show, Eq) + +data SortOrder + = SortNewest + | SortOldest + | SortUpdated + | SortPriorityHigh + | SortPriorityLow + deriving (Show, Eq) + +parseSortOrder :: Maybe Text -> SortOrder +parseSortOrder (Just "oldest") = SortOldest +parseSortOrder (Just "updated") = SortUpdated +parseSortOrder (Just "priority-high") = SortPriorityHigh +parseSortOrder (Just "priority-low") = SortPriorityLow +parseSortOrder _ = SortNewest + +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)" + +sortTasks :: SortOrder -> [TaskCore.Task] -> [TaskCore.Task] +sortTasks SortNewest = List.sortBy (comparing (Down <. TaskCore.taskCreatedAt)) +sortTasks SortOldest = List.sortBy (comparing TaskCore.taskCreatedAt) +sortTasks SortUpdated = List.sortBy (comparing (Down <. TaskCore.taskUpdatedAt)) +sortTasks SortPriorityHigh = List.sortBy (comparing TaskCore.taskPriority) +sortTasks SortPriorityLow = List.sortBy (comparing (Down <. TaskCore.taskPriority)) + +parseTimeRange :: Maybe Text -> TimeRange +parseTimeRange (Just "today") = Today +parseTimeRange (Just "week") = Week +parseTimeRange (Just "month") = Month +parseTimeRange _ = AllTime + +timeRangeToParam :: TimeRange -> Text +timeRangeToParam Today = "today" +timeRangeToParam Week = "week" +timeRangeToParam Month = "month" +timeRangeToParam AllTime = "all" + +getTimeRangeStart :: TimeRange -> UTCTime -> Maybe UTCTime +getTimeRangeStart AllTime _ = Nothing +getTimeRangeStart Today now = Just (startOfDay now) +getTimeRangeStart Week now = Just (startOfWeek now) +getTimeRangeStart Month now = Just (startOfMonth now) + +startOfDay :: UTCTime -> UTCTime +startOfDay t = UTCTime (utctDay t) 0 + +startOfWeek :: UTCTime -> UTCTime +startOfWeek t = + let day = utctDay t + dow = dayOfWeek day + daysBack = case dow of + Monday -> 0 + Tuesday -> 1 + Wednesday -> 2 + Thursday -> 3 + Friday -> 4 + Saturday -> 5 + Sunday -> 6 + in UTCTime (addDays (negate daysBack) day) 0 + +addDays :: Integer -> Day -> Day +addDays n d = + let (y, m, dayNum) = toGregorian d + in fromGregorian y m (dayNum + fromInteger n) + +fromGregorian :: Integer -> Int -> Int -> Day +fromGregorian y m d = toEnum (fromInteger (daysSinceEpoch y m d)) + +daysSinceEpoch :: Integer -> Int -> Int -> Integer +daysSinceEpoch y m d = + let a = (14 - m) `div` 12 + y' = y + 4800 - toInteger a + m' = m + 12 * a - 3 + jdn = d + (153 * m' + 2) `div` 5 + 365 * fromInteger y' + fromInteger y' `div` 4 - fromInteger y' `div` 100 + fromInteger y' `div` 400 - 32045 + in toInteger jdn - 2440588 + +startOfMonth :: UTCTime -> UTCTime +startOfMonth t = + let day = utctDay t + (y, m, _) = toGregorian day + in UTCTime (fromGregorian y m 1) 0 + +computeMetricsFromActivities :: [TaskCore.Task] -> [TaskCore.TaskActivity] -> TaskCore.AggregatedMetrics +computeMetricsFromActivities tasks activities = + let completedCount = length [t | t <- tasks, TaskCore.taskStatus t == TaskCore.Done] + totalCost = sum [c | act <- activities, Just c <- [TaskCore.activityCostCents act]] + totalTokens = sum [t | act <- activities, Just t <- [TaskCore.activityTokensUsed act]] + totalDuration = sum [calcDuration act | act <- activities] + in TaskCore.AggregatedMetrics + { TaskCore.aggTotalCostCents = totalCost, + TaskCore.aggTotalDurationSeconds = totalDuration, + TaskCore.aggCompletedTasks = completedCount, + TaskCore.aggTotalTokens = totalTokens + } + where + calcDuration act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + +data CSS + +instance Accept CSS where + contentType _ = "text/css" + +instance MimeRender CSS LazyText.Text where + mimeRender _ = LazyText.encodeUtf8 + +data SSE + +instance Accept SSE where + contentType _ = "text/event-stream" + +instance MimeRender SSE BS.ByteString where + mimeRender _ = LBS.fromStrict + +data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime + +data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime + +data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime + +data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTCTime + +data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime + +data TaskDetailPage + = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime + | TaskDetailNotFound Text + +data GitCommit = GitCommit + { commitHash :: Text, + commitShortHash :: Text, + commitSummary :: Text, + commitAuthor :: Text, + commitRelativeDate :: Text, + commitFilesChanged :: Int + } + deriving (Show, Eq) + +data TaskReviewPage + = ReviewPageFound TaskCore.Task ReviewInfo + | ReviewPageNotFound Text + +data ReviewInfo + = ReviewNoCommit + | ReviewMergeConflict Text [Text] + | ReviewReady Text Text + +data TaskDiffPage + = DiffPageFound Text Text Text + | DiffPageNotFound Text Text + +data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) + +newtype KBPage = KBPage [TaskCore.Fact] + +data FactDetailPage + = FactDetailFound TaskCore.Fact UTCTime + | FactDetailNotFound Int + +data FactEditForm = FactEditForm Text Text Text + +instance FromForm FactEditForm where + fromForm form = do + content <- parseUnique "content" form + let files = fromRight "" (lookupUnique "files" form) + let confidence = fromRight "0.8" (lookupUnique "confidence" form) + Right (FactEditForm content files confidence) + +data FactCreateForm = FactCreateForm Text Text Text Text + +instance FromForm FactCreateForm where + fromForm form = do + project <- parseUnique "project" form + content <- parseUnique "content" form + let files = fromRight "" (lookupUnique "files" form) + let confidence = fromRight "0.8" (lookupUnique "confidence" form) + Right (FactCreateForm project content files confidence) + +data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] SortOrder + +data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int) + +data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool + +newtype ReadyCountPartial = ReadyCountPartial Int + +data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text + +data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text + +data ComplexityBadgePartial = ComplexityBadgePartial (Maybe Int) Text + +newtype TaskListPartial = TaskListPartial [TaskCore.Task] + +data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime + +data AgentEventsPartial = AgentEventsPartial Text [TaskCore.StoredEvent] Bool UTCTime + +data DescriptionViewPartial = DescriptionViewPartial Text Text Bool + +data DescriptionEditPartial = DescriptionEditPartial Text Text Bool + +newtype RejectForm = RejectForm (Maybe Text) + +instance FromForm RejectForm where + fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form))) + +newtype StatusForm = StatusForm TaskCore.Status + +instance FromForm StatusForm where + fromForm form = do + statusText <- parseUnique "status" form + case readMaybe (Text.unpack statusText) of + Just s -> Right (StatusForm s) + Nothing -> Left "Invalid status" + +newtype PriorityForm = PriorityForm TaskCore.Priority + +instance FromForm PriorityForm where + fromForm form = do + priorityText <- parseUnique "priority" form + case readMaybe (Text.unpack priorityText) of + Just p -> Right (PriorityForm p) + Nothing -> Left "Invalid priority" + +newtype ComplexityForm = ComplexityForm (Maybe Int) + +instance FromForm ComplexityForm where + fromForm form = do + complexityText <- parseUnique "complexity" form + if complexityText == "none" + then Right (ComplexityForm Nothing) + else case readMaybe (Text.unpack complexityText) of + Just c | c >= 1 && c <= 5 -> Right (ComplexityForm (Just c)) + _ -> Left "Invalid complexity" + +newtype DescriptionForm = DescriptionForm Text + +instance FromForm DescriptionForm where + fromForm form = do + desc <- parseUnique "description" form + Right (DescriptionForm desc) + +newtype NotesForm = NotesForm Text + +instance FromForm NotesForm where + fromForm form = do + notes <- parseUnique "notes" form + Right (NotesForm notes) + +newtype CommentForm = CommentForm Text + +instance FromForm CommentForm where + fromForm form = do + commentText <- parseUnique "comment" form + Right (CommentForm commentText) + +data Breadcrumb = Breadcrumb + { breadcrumbLabel :: Text, + breadcrumbUrl :: Maybe Text + } + +type Breadcrumbs = [Breadcrumb] |