{-# 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 (..), complexityBadge, 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) case TaskCore.taskComplexity task of Nothing -> pure () Just c -> do metaSep complexityBadge c 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))