diff options
Diffstat (limited to 'Omni/Jr/Web/Pages.hs')
| -rw-r--r-- | Omni/Jr/Web/Pages.hs | 862 |
1 files changed, 862 insertions, 0 deletions
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)) |
