summaryrefslogtreecommitdiff
path: root/Omni/Jr/Web/Pages.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr/Web/Pages.hs')
-rw-r--r--Omni/Jr/Web/Pages.hs862
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))