Show task complexity on /tasks/<id> page

1: # Omni
2: 
3: The Omni project is to leverage automation and asymmetries to create wealth.
4: 
5: ## Critical Rules for AI Agents
6: 
7: **CRITICAL**: This project uses `jr task` for ALL issue tracking. You MUST follow these rules:
8: 
9: - ✅ Use `jr task` for ALL task/TODO tracking (`jr task create ... --json`)
10: - ✅ Link discovered work with `--discovered-from=<parent-id>`
11: - ✅ File bugs IMMEDIATELY when you discover unexpected behavior
12: - ✅ Add facts to the knowledge base when you learn something useful (`jr facts add ...`)
13: - ✅ Run `jr task ready --json` before asking "what should I work on?"
14: - ✅ Store AI planning docs in `_/llm` directory (NEVER in repo root)
15: - ❌ Do NOT use `todo_write` tool
16: - ❌ Do NOT create markdown TODO lists or task checklists
17: - ❌ Do NOT put TODO/FIXME comments in code
18: 
19: ## Cheat Sheet
20: 
21: **Standard workflow:**
22: ```bash
23: # 1. Find ready work
24: jr task ready --json
25: 
26: # 2. Claim a task
27: jr task update <id> in-progress --json
28: 
29: # 3. During work: create discovered issues
30: jr task create "Fix type error found" --discovered-from=<current-id> --json
31: 
32: # 4. Complete the task
33: jr task update <id> done --json
34: ```
35: 
36: **Bug Discovery:**
37: ```bash
38: # Create a task immediately
39: jr task create "Command X fails when Y" --discovered-from=<current-task-id> --json
40: ```
41: 
42: ## Directory Structure
43: 
44: - **`_/`** (cabdir) - All ephemeral/generated files. This directory is gitignored.
45:   - `_/llm/` - AI planning docs and agent logs
46:   - `_/tmp/` - Temporary files, test databases, scratch data
47: - Never create dotfile directories (like `.tasks/`) in the repo root
48: 
49: ## Common Commands
50: 
51: **Build:**
52: ```bash
53: bild Omni/Jr.hs              # Build a Haskell namespace
54: bild Biz/Cloud/Api.py        # Build a Python namespace
55: ```
56: 
57: **Lint and Format:**
58: ```bash
59: lint Omni/Cli.hs             # Lint a file (DO NOT use hlint directly)
60: lint --fix **/*.py           # Lint and auto-fix Python files
61: ```
62: 
63: **Type Check:**
64: ```bash
65: typecheck.sh Omni/Bild/Example.py   # Run mypy on Python files
66: ```
67: 
68: **Test:**
69: ```bash
70: bild --test Omni/Jr.hs       # Build and run tests for a namespace
71: ```
72: 
73: **Run:**
74: ```bash
75: Omni/Ide/run.sh Omni/Jr.hs   # Build (if needed) and run
76: ```
77: 
78: ## Documentation
79: 
80: - **Project Context**: [README.md](README.md) - Goals, source layout, and coding conventions.
81: - **Task Manager**: [`Omni/Task/README.md`](Omni/Task/README.md) - Detailed usage, dependency management, and agent best practices.
82: - **Build Tool (Bild)**: [`Omni/Bild/README.md`](Omni/Bild/README.md) - How to use `bild` and manage dependencies.
83: - **Development Tools**: [`Omni/Ide/README.md`](Omni/Ide/README.md) - `run.sh`, `lint`, `repl.sh`, git workflow.

./Omni/Jr/Web.hs:217:      :> Get '[Lucid.HTML] TaskListPage
./Omni/Jr/Web.hs:224:    :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
./Omni/Jr/Web.hs:232:    :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
./Omni/Jr/Web.hs:233:    :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
./Omni/Jr/Web.hs:276:data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
./Omni/Jr/Web.hs:278:data TaskDetailPage
./Omni/Jr/Web.hs:292:data TaskReviewPage
./Omni/Jr/Web.hs:301:data TaskDiffPage
./Omni/Jr/Web.hs:1412:instance Lucid.ToHtml TaskListPage where
./Omni/Jr/Web.hs:1414:  toHtml (TaskListPage tasks filters currentSort _now) =
./Omni/Jr/Web.hs:1494:instance Lucid.ToHtml TaskDetailPage where
./Omni/Jr/Web.hs:1819:instance Lucid.ToHtml TaskReviewPage where
./Omni/Jr/Web.hs:1897:instance Lucid.ToHtml TaskDiffPage where
./Omni/Jr/Web.hs:2811:    taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
./Omni/Jr/Web.hs:2821:      pure (TaskListPage filteredTasks filters sortOrder now)
./Omni/Jr/Web.hs:2903:    taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
./Omni/Jr/Web.hs:2963:    taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
./Omni/Jr/Web.hs:2972:    taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage
./Omni/Jr/Web.hs:3031:          pageTasks = take pageSize <| drop offset sortedTasks
./Omni/Jr/Web.hs:3032:          hasMore = length sortedTasks > offset + pageSize

278: data TaskDetailPage
279:   = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
280:   | TaskDetailNotFound Text
281: 
282: data GitCommit = GitCommit
283:   { commitHash :: Text,
284:     commitShortHash :: Text,
285:     commitSummary :: Text,
286:     commitAuthor :: Text,
287:     commitRelativeDate :: Text,
288:     commitFilesChanged :: Int
289:   }
290:   deriving (Show, Eq)
291: 
292: data TaskReviewPage
293:   = ReviewPageFound TaskCore.Task ReviewInfo
294:   | ReviewPageNotFound Text
295: 
296: data ReviewInfo
297:   = ReviewNoCommit
298:   | ReviewMergeConflict Text [Text]
299:   | ReviewReady Text Text
300: 
301: data TaskDiffPage
302:   = DiffPageFound Text Text Text
303:   | DiffPageNotFound Text Text
304: 
305: data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
306: 
307: newtype KBPage = KBPage [TaskCore.Fact]
308: 
309: data FactDetailPage
310:   = FactDetailFound TaskCore.Fact UTCTime

1494: instance Lucid.ToHtml TaskDetailPage where
1495:   toHtmlRaw = Lucid.toHtml
1496:   toHtml (TaskDetailNotFound tid) =
1497:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid Nothing]
1498:      in Lucid.doctypehtml_ <| do
1499:           pageHead "Task Not Found - Jr"
1500:           pageBodyWithCrumbs crumbs <| do
1501:             Lucid.div_ [Lucid.class_ "container"] <| do
1502:               Lucid.h1_ "Task Not Found"
1503:               Lucid.p_ <| do
1504:                 "The task "
1505:                 Lucid.code_ (Lucid.toHtml tid)
1506:                 " could not be found."
1507:   toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics agentEvents now) =
1508:     let crumbs = taskBreadcrumbs allTasks task
1509:      in Lucid.doctypehtml_ <| do
1510:           pageHead (TaskCore.taskId task <> " - Jr")
1511:           pageBodyWithCrumbs crumbs <| do
1512:             Lucid.div_ [Lucid.class_ "container"] <| do
1513:               Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
1514: 
1515:               renderRetryContextBanner (TaskCore.taskId task) maybeRetry
1516: 
1517:               Lucid.div_ [Lucid.class_ "task-detail"] <| do
1518:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1519:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1520:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1521:                     metaSep
1522:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1523:                     metaSep
1524:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                     metaSep
1526:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1527:                     case TaskCore.taskNamespace task of
1528:                       Nothing -> pure ()
1529:                       Just ns -> do
1530:                         metaSep
1531:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
1532: 
1533:                   Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
1534:                     case TaskCore.taskParent task of
1535:                       Nothing -> pure ()
1536:                       Just pid -> do
1537:                         Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
1538:                         Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
1539:                         metaSep
1540:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
1541:                     renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
1542:                     metaSep
1543:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
1544:                     renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
1545: 
1546:                 let deps = TaskCore.taskDependencies task
1547:                 unless (null deps) <| do
1548:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1549:                     Lucid.h3_ "Dependencies"
1550:                     Lucid.ul_ [Lucid.class_ "dep-list"] <| do
1551:                       traverse_ renderDependency deps
1552: 
1553:                 when (TaskCore.taskType task == TaskCore.Epic) <| do
1554:                   for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
1555: 
1556:                 Lucid.div_ [Lucid.class_ "detail-section"] <| do
1557:                   Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
1558: 
1559:                 let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
1560:                 unless (null children) <| do
1561:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1562:                     Lucid.h3_ "Child Tasks"
1563:                     Lucid.ul_ [Lucid.class_ "child-list"] <| do
1564:                       traverse_ renderChild children
1565: 
1566:                 unless (null commits) <| do
1567:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1568:                     Lucid.h3_ "Git Commits"
1569:                     Lucid.div_ [Lucid.class_ "commit-list"] <| do
1570:                       traverse_ (renderCommit (TaskCore.taskId task)) commits
1571: 
1572:               let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities
1573:               when hasRunningActivity <| do
1574:                 let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress
1575:                     htmxAttrs =
1576:                       [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> TaskCore.taskId task <> "/metrics"),
1577:                         Lucid.makeAttribute "hx-trigger" "every 5s",
1578:                         Lucid.makeAttribute "hx-swap" "innerHTML"
1579:                       ]
1580:                     sectionAttrs =
1581:                       [Lucid.class_ "execution-section", Lucid.id_ "execution-details"]
1582:                         <> [attr | isInProgress, attr <- htmxAttrs]
1583:                 Lucid.div_ sectionAttrs <| do
1584:                   Lucid.h3_ "Execution Details"
1585:                   renderExecutionDetails (TaskCore.taskId task) activities maybeRetry
1586: 
1587:               when (TaskCore.taskStatus task == TaskCore.Review) <| do
1588:                 Lucid.div_ [Lucid.class_ "review-link-section"] <| do
1589:                   Lucid.a_
1590:                     [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
1591:                       Lucid.class_ "review-link-btn"
1592:                     ]
1593:                     "Review This Task"
1594: 
1595:               renderUnifiedTimeline (TaskCore.taskId task) (TaskCore.taskComments task) agentEvents (TaskCore.taskStatus task) now
1596:     where
1597:       renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
1598:       renderDependency dep =
1599:         Lucid.li_ <| do
1600:           Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
1601:           Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]")
1602: 
1603:       renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
1604:       renderChild child =
1605:         Lucid.li_ <| do
1606:           Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
1607:           Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
1608:           Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")
1609: 
1610:       renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m ()
1611:       renderCommit tid c =
1612:         Lucid.div_ [Lucid.class_ "commit-item"] <| do
1613:           Lucid.div_ [Lucid.class_ "commit-header"] <| do
1614:             Lucid.a_
1615:               [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
1616:                 Lucid.class_ "commit-hash"
1617:               ]
1618:               (Lucid.toHtml (commitShortHash c))
1619:             Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c))
1620:           Lucid.div_ [Lucid.class_ "commit-meta"] <| do
1621:             Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c))
1622:             Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c))
1623:             Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files"))
1624: 
1625:       renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
1626:       renderExecutionDetails _ acts retryCtx =
1627:         let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) acts
1628:          in if null runningActs
1629:               then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
1630:               else
1631:                 Lucid.div_ [Lucid.class_ "execution-details"] <| do
1632:                   let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
1633:                       totalDuration = sum [calcDurSecs act | act <- runningActs]
1634:                       attemptCount = length runningActs
1635: 
1636:                   case retryCtx of
1637:                     Nothing -> pure ()
1638:                     Just ctx ->
1639:                       Lucid.div_ [Lucid.class_ "metric-row"] <| do
1640:                         Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
1641:                         Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
1642: 
1643:                   when (attemptCount > 1) <| do
1644:                     Lucid.div_ [Lucid.class_ "metric-row"] <| do
1645:                       Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
1646:                       Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
1647:                     Lucid.div_ [Lucid.class_ "metric-row"] <| do
1648:                       Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
1649:                       Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
1650:                     when (totalCost > 0)

./Omni/Task.hs:271:                taskComplexity = fromMaybe (taskComplexity task) maybeComplexity,
./Omni/Task.hs:640:        taskComplexity task Test.@?= Just 4,
./Omni/Task.hs:646:          Just reloaded -> taskComplexity reloaded Test.@?= Just 3,
./Omni/Task.hs:725:                  taskComplexity = Nothing,
./Omni/Agent/Worker.hs:428:selectModel task = selectModelByComplexity (TaskCore.taskComplexity task)
./Omni/Task/Core.hs:32:data Task = Task
./Omni/Task/Core.hs:40:    taskComplexity :: Maybe Int, -- Complexity 1-5 for model selection
./Omni/Task/Core.hs:49:data TaskType = Epic | WorkTask | HumanTask
./Omni/Task/Core.hs:72:data TaskProgress = TaskProgress
./Omni/Task/Core.hs:118:data TaskActivity = TaskActivity
./Omni/Task/Core.hs:323:      SQL.toField (taskComplexity t),
./Omni/Task/Core.hs:674:              taskComplexity = complexity,
./Omni/Task/Core.hs:1020:  case taskComplexity t of
./Omni/Task/Core.hs:1098:data TaskStats = TaskStats
./Omni/Jr/Web.hs:83:data TaskFilters = TaskFilters
./Omni/Jr/Web.hs:276:data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
./Omni/Jr/Web.hs:346:data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime

1518:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1519:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1520:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1521:                     metaSep
1522:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1523:                     metaSep
1524:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                     metaSep
1526:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1527:                     case TaskCore.taskNamespace task of
1528:                       Nothing -> pure ()
1529:                       Just ns -> do
1530:                         metaSep
1531:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
1532: 

80:metaSep :: (Monad m) => Lucid.HtmlT m ()
81:metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
225:    :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
226:    :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
340:data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
342:data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
674:statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675:statusBadge status =
748:statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
749:statusBadgeWithForm status tid =
824:priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
825:priorityBadgeWithForm priority tid =
831:      clickablePriorityBadge priority tid
834:clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
835:clickablePriorityBadge priority _tid =
906:        statusBadge (TaskCore.taskStatus t)
919:        statusBadge (TaskCore.taskStatus t)
936:        statusBadge (TaskCore.taskStatus t)
1400:            statusBadge (TaskCore.taskStatus t)
1521:                    metaSep
1523:                    metaSep
1524:                    statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                    metaSep
1526:                    priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1530:                        metaSep
1539:                        metaSep
1542:                    metaSep
1850:                  Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
2065:instance Lucid.ToHtml StatusBadgePartial where
2067:  toHtml (StatusBadgePartial status tid) =
2068:    statusBadgeWithForm status tid
2070:instance Lucid.ToHtml PriorityBadgePartial where
2072:  toHtml (PriorityBadgePartial priority tid) =
2073:    priorityBadgeWithForm priority tid
2920:    taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
2923:      pure (StatusBadgePartial newStatus tid)
2925:    taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
2928:      pure (PriorityBadgePartial newPriority tid)

674: statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675: statusBadge status =
676:   let (cls, label) = case status of
677:         TaskCore.Draft -> ("badge badge-draft", "Draft")
678:         TaskCore.Open -> ("badge badge-open", "Open")
679:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
680:         TaskCore.Review -> ("badge badge-review", "Review")
681:         TaskCore.Approved -> ("badge badge-approved", "Approved")
682:         TaskCore.Done -> ("badge badge-done", "Done")
683:    in Lucid.span_ [Lucid.class_ cls] label
684: 
685: sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
686: sortDropdown basePath currentSort =
687:   Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
688:     Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
689:     Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
690:       Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
691:         <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
692:       Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
693:         sortOption basePath SortNewest currentSort
694:         sortOption basePath SortOldest currentSort
695:         sortOption basePath SortUpdated currentSort
696:         sortOption basePath SortPriorityHigh currentSort
697:         sortOption basePath SortPriorityLow currentSort
698: 
699: sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
700: sortOption basePath option currentSort =
701:   let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
702:       href = basePath <> "?sort=" <> sortOrderToParam option
703:    in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
704: 
705: multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
706: multiColorProgressBar stats =
707:   let total = TaskCore.totalTasks stats
708:       doneCount = TaskCore.doneTasks stats
709:       inProgressCount = TaskCore.inProgressTasks stats
710:       openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
711:       donePct = if total == 0 then 0 else (doneCount * 100) `div` total
712:       inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
713:       openPct = if total == 0 then 0 else (openCount * 100) `div` total
714:    in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
715:         Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
716:           when (donePct > 0)
717:             <| Lucid.div_
718:               [ Lucid.class_ "multi-progress-segment progress-done",
719:                 Lucid.style_ ("width: " <> tshow donePct <> "%"),
720:                 Lucid.title_ (tshow doneCount <> " done")
721:               ]
722:               ""
723:           when (inProgressPct > 0)
724:             <| Lucid.div_
725:               [ Lucid.class_ "multi-progress-segment progress-inprogress",
726:                 Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
727:                 Lucid.title_ (tshow inProgressCount <> " in progress")
728:               ]
729:               ""
730:           when (openPct > 0)
731:             <| Lucid.div_
732:               [ Lucid.class_ "multi-progress-segment progress-open",
733:                 Lucid.style_ ("width: " <> tshow openPct <> "%"),
734:                 Lucid.title_ (tshow openCount <> " open")
735:               ]
736:               ""
737:         Lucid.div_ [Lucid.class_ "progress-legend"] <| do
738:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
739:             Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
740:             Lucid.toHtml ("Done " <> tshow doneCount)
741:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
742:             Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
743:             Lucid.toHtml ("In Progress " <> tshow inProgressCount)
744:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
745:             Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
746:             Lucid.toHtml ("Open " <> tshow openCount)
747: 
748: statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
749: statusBadgeWithForm status tid =
750:   Lucid.div_

1: # Omni
2: 
3: The Omni project is to leverage automation and asymmetries to create wealth.
4: 
5: ## Critical Rules for AI Agents
6: 
7: **CRITICAL**: This project uses `jr task` for ALL issue tracking. You MUST follow these rules:
8: 
9: - ✅ Use `jr task` for ALL task/TODO tracking (`jr task create ... --json`)
10: - ✅ Link discovered work with `--discovered-from=<parent-id>`
11: - ✅ File bugs IMMEDIATELY when you discover unexpected behavior
12: - ✅ Add facts to the knowledge base when you learn something useful (`jr facts add ...`)
13: - ✅ Run `jr task ready --json` before asking "what should I work on?"
14: - ✅ Store AI planning docs in `_/llm` directory (NEVER in repo root)
15: - ❌ Do NOT use `todo_write` tool
16: - ❌ Do NOT create markdown TODO lists or task checklists
17: - ❌ Do NOT put TODO/FIXME comments in code
18: 
19: ## Cheat Sheet
20: 
21: **Standard workflow:**
22: ```bash
23: # 1. Find ready work
24: jr task ready --json
25: 
26: # 2. Claim a task
27: jr task update <id> in-progress --json
28: 
29: # 3. During work: create discovered issues
30: jr task create "Fix type error found" --discovered-from=<current-id> --json
31: 
32: # 4. Complete the task
33: jr task update <id> done --json
34: ```
35: 
36: **Bug Discovery:**
37: ```bash
38: # Create a task immediately
39: jr task create "Command X fails when Y" --discovered-from=<current-task-id> --json
40: ```
41: 
42: ## Directory Structure
43: 
44: - **`_/`** (cabdir) - All ephemeral/generated files. This directory is gitignored.
45:   - `_/llm/` - AI planning docs and agent logs
46:   - `_/tmp/` - Temporary files, test databases, scratch data
47: - Never create dotfile directories (like `.tasks/`) in the repo root
48: 
49: ## Common Commands
50: 
51: **Build:**
52: ```bash
53: bild Omni/Jr.hs              # Build a Haskell namespace
54: bild Biz/Cloud/Api.py        # Build a Python namespace
55: ```
56: 
57: **Lint and Format:**
58: ```bash
59: lint Omni/Cli.hs             # Lint a file (DO NOT use hlint directly)
60: lint --fix **/*.py           # Lint and auto-fix Python files
61: ```
62: 
63: **Type Check:**
64: ```bash
65: typecheck.sh Omni/Bild/Example.py   # Run mypy on Python files
66: ```
67: 
68: **Test:**
69: ```bash
70: bild --test Omni/Jr.hs       # Build and run tests for a namespace
71: ```
72: 
73: **Run:**
74: ```bash
75: Omni/Ide/run.sh Omni/Jr.hs   # Build (if needed) and run
76: ```
77: 
78: ## Documentation
79: 
80: - **Project Context**: [README.md](README.md) - Goals, source layout, and coding conventions.
81: - **Task Manager**: [`Omni/Task/README.md`](Omni/Task/README.md) - Detailed usage, dependency management, and agent best practices.
82: - **Build Tool (Bild)**: [`Omni/Bild/README.md`](Omni/Bild/README.md) - How to use `bild` and manage dependencies.
83: - **Development Tools**: [`Omni/Ide/README.md`](Omni/Ide/README.md) - `run.sh`, `lint`, `repl.sh`, git workflow.

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE TypeOperators #-}
4: {-# LANGUAGE NoImplicitPrelude #-}
5: 
6: -- : dep warp
7: -- : dep servant-server
8: -- : dep lucid
9: -- : dep servant-lucid
10: -- : dep http-api-data
11: -- : dep process
12: -- : dep clay
13: module Omni.Jr.Web
14:   ( run,
15:     defaultPort,
16:   )
17: where
18: 
19: import Alpha
20: import qualified Control.Concurrent as Concurrent
21: import qualified Data.Aeson as Aeson
22: import qualified Data.Aeson.KeyMap as KeyMap
23: import qualified Data.ByteString.Lazy as LBS
24: import qualified Data.List as List
25: import qualified Data.Text as Text
26: import qualified Data.Text.Lazy as LazyText
27: import qualified Data.Text.Lazy.Encoding as LazyText
28: import Data.Time (Day, NominalDiffTime, UTCTime (..), dayOfWeek, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime, toGregorian)
29: import Data.Time.Calendar (DayOfWeek (..))
30: import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
31: import qualified Lucid
32: import qualified Lucid.Base as Lucid
33: import qualified Network.Wai.Handler.Warp as Warp
34: import Numeric (showFFloat)
35: import qualified Omni.Fact as Fact
36: import qualified Omni.Jr.Web.Style as Style
37: import qualified Omni.Task.Core as TaskCore
38: import Servant
39: import qualified Servant.HTML.Lucid as Lucid
40: import qualified Servant.Types.SourceT as Source
41: import qualified System.Exit as Exit
42: import qualified System.Process as Process
43: import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
44: 
45: type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
46: 
47: defaultPort :: Warp.Port
48: defaultPort = 8080
49: 
50: formatRelativeTime :: UTCTime -> UTCTime -> Text
51: formatRelativeTime now timestamp =
52:   let delta = diffUTCTime now timestamp
53:    in relativeText delta
54: 
55: relativeText :: NominalDiffTime -> Text
56: relativeText delta
57:   | delta < 60 = "just now"
58:   | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
59:   | delta < 7200 = "1 hour ago"
60:   | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
61:   | delta < 172800 = "yesterday"
62:   | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
63:   | delta < 1209600 = "1 week ago"
64:   | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
65:   | delta < 5184000 = "1 month ago"
66:   | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
67:   | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"
68: 
69: formatExactTimestamp :: UTCTime -> Text
70: formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
71: 
72: renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
73: renderRelativeTimestamp now timestamp =
74:   Lucid.span_
75:     [ Lucid.class_ "relative-time",
76:       Lucid.title_ (formatExactTimestamp timestamp)
77:     ]
78:     (Lucid.toHtml (formatRelativeTime now timestamp))
79: 
80: metaSep :: (Monad m) => Lucid.HtmlT m ()
81: metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
82: 
83: data TaskFilters = TaskFilters
84:   { filterStatus :: Maybe TaskCore.Status,
85:     filterPriority :: Maybe TaskCore.Priority,
86:     filterNamespace :: Maybe Text,
87:     filterType :: Maybe TaskCore.TaskType
88:   }
89:   deriving (Show, Eq)
90: 
91: data TimeRange = Today | Week | Month | AllTime
92:   deriving (Show, Eq)
93: 
94: data SortOrder
95:   = SortNewest
96:   | SortOldest
97:   | SortUpdated
98:   | SortPriorityHigh
99:   | SortPriorityLow
100:   deriving (Show, Eq)
101: 
102: parseSortOrder :: Maybe Text -> SortOrder
103: parseSortOrder (Just "oldest") = SortOldest
104: parseSortOrder (Just "updated") = SortUpdated
105: parseSortOrder (Just "priority-high") = SortPriorityHigh
106: parseSortOrder (Just "priority-low") = SortPriorityLow
107: parseSortOrder _ = SortNewest
108: 
109: sortOrderToParam :: SortOrder -> Text
110: sortOrderToParam SortNewest = "newest"
111: sortOrderToParam SortOldest = "oldest"
112: sortOrderToParam SortUpdated = "updated"
113: sortOrderToParam SortPriorityHigh = "priority-high"
114: sortOrderToParam SortPriorityLow = "priority-low"
115: 
116: sortOrderLabel :: SortOrder -> Text
117: sortOrderLabel SortNewest = "Newest First"
118: sortOrderLabel SortOldest = "Oldest First"
119: sortOrderLabel SortUpdated = "Recently Updated"
120: sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
121: sortOrderLabel SortPriorityLow = "Priority (Low to High)"
122: 
123: sortTasks :: SortOrder -> [TaskCore.Task] -> [TaskCore.Task]
124: sortTasks SortNewest = List.sortBy (comparing (Down <. TaskCore.taskCreatedAt))
125: sortTasks SortOldest = List.sortBy (comparing TaskCore.taskCreatedAt)
126: sortTasks SortUpdated = List.sortBy (comparing (Down <. TaskCore.taskUpdatedAt))
127: sortTasks SortPriorityHigh = List.sortBy (comparing TaskCore.taskPriority)
128: sortTasks SortPriorityLow = List.sortBy (comparing (Down <. TaskCore.taskPriority))
129: 
130: parseTimeRange :: Maybe Text -> TimeRange
131: parseTimeRange (Just "today") = Today
132: parseTimeRange (Just "week") = Week
133: parseTimeRange (Just "month") = Month
134: parseTimeRange _ = AllTime
135: 
136: timeRangeToParam :: TimeRange -> Text
137: timeRangeToParam Today = "today"
138: timeRangeToParam Week = "week"
139: timeRangeToParam Month = "month"
140: timeRangeToParam AllTime = "all"
141: 
142: getTimeRangeStart :: TimeRange -> UTCTime -> Maybe UTCTime
143: getTimeRangeStart AllTime _ = Nothing
144: getTimeRangeStart Today now = Just (startOfDay now)
145: getTimeRangeStart Week now = Just (startOfWeek now)
146: getTimeRangeStart Month now = Just (startOfMonth now)
147: 
148: startOfDay :: UTCTime -> UTCTime
149: startOfDay t = UTCTime (utctDay t) 0
150: 
151: startOfWeek :: UTCTime -> UTCTime
152: startOfWeek t =
153:   let day = utctDay t
154:       dow = dayOfWeek day
155:       daysBack = case dow of
156:         Monday -> 0
157:         Tuesday -> 1
158:         Wednesday -> 2
159:         Thursday -> 3
160:         Friday -> 4
161:         Saturday -> 5
162:         Sunday -> 6
163:    in UTCTime (addDays (negate daysBack) day) 0
164: 
165: addDays :: Integer -> Day -> Day
166: addDays n d =
167:   let (y, m, dayNum) = toGregorian d
168:    in fromGregorian y m (dayNum + fromInteger n)
169: 
170: fromGregorian :: Integer -> Int -> Int -> Day
171: fromGregorian y m d = toEnum (fromInteger (daysSinceEpoch y m d))
172: 
173: daysSinceEpoch :: Integer -> Int -> Int -> Integer
174: daysSinceEpoch y m d =
175:   let a = (14 - m) `div` 12
176:       y' = y + 4800 - toInteger a
177:       m' = m + 12 * a - 3
178:       jdn = d + (153 * m' + 2) `div` 5 + 365 * fromInteger y' + fromInteger y' `div` 4 - fromInteger y' `div` 100 + fromInteger y' `div` 400 - 32045
179:    in toInteger jdn - 2440588
180: 
181: startOfMonth :: UTCTime -> UTCTime
182: startOfMonth t =
183:   let day = utctDay t
184:       (y, m, _) = toGregorian day
185:    in UTCTime (fromGregorian y m 1) 0
186: 
187: computeMetricsFromActivities :: [TaskCore.Task] -> [TaskCore.TaskActivity] -> TaskCore.AggregatedMetrics
188: computeMetricsFromActivities tasks activities =
189:   let completedCount = length [t | t <- tasks, TaskCore.taskStatus t == TaskCore.Done]
190:       totalCost = sum [c | act <- activities, Just c <- [TaskCore.activityCostCents act]]
191:       totalTokens = sum [t | act <- activities, Just t <- [TaskCore.activityTokensUsed act]]
192:       totalDuration = sum [calcDuration act | act <- activities]
193:    in TaskCore.AggregatedMetrics
194:         { TaskCore.aggTotalCostCents = totalCost,
195:           TaskCore.aggTotalDurationSeconds = totalDuration,
196:           TaskCore.aggCompletedTasks = completedCount,
197:           TaskCore.aggTotalTokens = totalTokens
198:         }
199:   where
200:     calcDuration act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
201:       (Just start, Just end) -> floor (diffUTCTime end start)
202:       _ -> 0
203: 
204: type API =
205:   QueryParam "range" Text :> Get '[Lucid.HTML] HomePage
206:     :<|> "style.css" :> Get '[CSS] LazyText.Text
207:     :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage
208:     :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage
209:     :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage
210:     :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
211:     :<|> "tasks"
212:       :> QueryParam "status" Text
213:       :> QueryParam "priority" Text
214:       :> QueryParam "namespace" Text
215:       :> QueryParam "type" Text
216:       :> QueryParam "sort" Text
217:       :> Get '[Lucid.HTML] TaskListPage
218:     :<|> "kb" :> Get '[Lucid.HTML] KBPage
219:     :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
220:     :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
221:     :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
222:     :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
223:     :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
224:     :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
225:     :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
226:     :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
227:     :<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
228:     :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial
229:     :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial
230:     :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
231:     :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect
232:     :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
233:     :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
234:     :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
235:     :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
236:     :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect
237:     :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial
238:     :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial
239:     :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
240:     :<|> "partials"
241:       :> "task-list"
242:       :> QueryParam "status" Text
243:       :> QueryParam "priority" Text
244:       :> QueryParam "namespace" Text
245:       :> QueryParam "type" Text
246:       :> QueryParam "sort" Text
247:       :> Get '[Lucid.HTML] TaskListPartial
248:     :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
249:     :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial
250:     :<|> "tasks" :> Capture "id" Text :> "events" :> "stream" :> StreamGet NoFraming SSE (SourceIO ByteString)
251: 
252: data CSS
253: 
254: instance Accept CSS where
255:   contentType _ = "text/css"
256: 
257: instance MimeRender CSS LazyText.Text where
258:   mimeRender _ = LazyText.encodeUtf8
259: 
260: data SSE
261: 
262: instance Accept SSE where
263:   contentType _ = "text/event-stream"
264: 
265: instance MimeRender SSE ByteString where
266:   mimeRender _ = LBS.fromStrict
267: 
268: data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime
269: 
270: data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
271: 
272: data BlockedPage = BlockedPage [(TaskCore.Task, Int)] SortOrder UTCTime
273: 
274: data InterventionPage = InterventionPage TaskCore.HumanActionItems SortOrder UTCTime
275: 
276: data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
277: 
278: data TaskDetailPage
279:   = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
280:   | TaskDetailNotFound Text
281: 
282: data GitCommit = GitCommit
283:   { commitHash :: Text,
284:     commitShortHash :: Text,
285:     commitSummary :: Text,
286:     commitAuthor :: Text,
287:     commitRelativeDate :: Text,
288:     commitFilesChanged :: Int
289:   }
290:   deriving (Show, Eq)
291: 
292: data TaskReviewPage
293:   = ReviewPageFound TaskCore.Task ReviewInfo
294:   | ReviewPageNotFound Text
295: 
296: data ReviewInfo
297:   = ReviewNoCommit
298:   | ReviewMergeConflict Text [Text]
299:   | ReviewReady Text Text
300: 
301: data TaskDiffPage
302:   = DiffPageFound Text Text Text
303:   | DiffPageNotFound Text Text
304: 
305: data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)
306: 
307: newtype KBPage = KBPage [TaskCore.Fact]
308: 
309: data FactDetailPage
310:   = FactDetailFound TaskCore.Fact UTCTime
311:   | FactDetailNotFound Int
312: 
313: data FactEditForm = FactEditForm Text Text Text
314: 
315: instance FromForm FactEditForm where
316:   fromForm form = do
317:     content <- parseUnique "content" form
318:     let files = fromRight "" (lookupUnique "files" form)
319:     let confidence = fromRight "0.8" (lookupUnique "confidence" form)
320:     Right (FactEditForm content files confidence)
321: 
322: data FactCreateForm = FactCreateForm Text Text Text Text
323: 
324: instance FromForm FactCreateForm where
325:   fromForm form = do
326:     project <- parseUnique "project" form
327:     content <- parseUnique "content" form
328:     let files = fromRight "" (lookupUnique "files" form)
329:     let confidence = fromRight "0.8" (lookupUnique "confidence" form)
330:     Right (FactCreateForm project content files confidence)
331: 
332: data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] SortOrder
333: 
334: data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int)
335: 
336: data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool
337: 
338: newtype ReadyCountPartial = ReadyCountPartial Int
339: 
340: data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
341: 
342: data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
343: 
344: newtype TaskListPartial = TaskListPartial [TaskCore.Task]
345: 
346: data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
347: 
348: data AgentEventsPartial = AgentEventsPartial [TaskCore.StoredEvent] Bool UTCTime
349: 
350: data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
351: 
352: data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
353: 
354: newtype RejectForm = RejectForm (Maybe Text)
355: 
356: instance FromForm RejectForm where
357:   fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
358: 
359: newtype StatusForm = StatusForm TaskCore.Status
360: 
361: instance FromForm StatusForm where
362:   fromForm form = do
363:     statusText <- parseUnique "status" form
364:     case readMaybe (Text.unpack statusText) of
365:       Just s -> Right (StatusForm s)
366:       Nothing -> Left "Invalid status"
367: 
368: newtype PriorityForm = PriorityForm TaskCore.Priority
369: 
370: instance FromForm PriorityForm where
371:   fromForm form = do
372:     priorityText <- parseUnique "priority" form
373:     case readMaybe (Text.unpack priorityText) of
374:       Just p -> Right (PriorityForm p)
375:       Nothing -> Left "Invalid priority"
376: 
377: newtype DescriptionForm = DescriptionForm Text
378: 
379: instance FromForm DescriptionForm where
380:   fromForm form = do
381:     desc <- parseUnique "description" form
382:     Right (DescriptionForm desc)
383: 
384: newtype NotesForm = NotesForm Text
385: 
386: instance FromForm NotesForm where
387:   fromForm form = do
388:     notes <- parseUnique "notes" form
389:     Right (NotesForm notes)
390: 
391: newtype CommentForm = CommentForm Text
392: 
393: instance FromForm CommentForm where
394:   fromForm form = do
395:     commentText <- parseUnique "comment" form
396:     Right (CommentForm commentText)
397: 
398: pageHead :: (Monad m) => Text -> Lucid.HtmlT m ()
399: pageHead title =
400:   Lucid.head_ <| do
401:     Lucid.title_ (Lucid.toHtml title)
402:     Lucid.meta_ [Lucid.charset_ "utf-8"]
403:     Lucid.meta_
404:       [ Lucid.name_ "viewport",
405:         Lucid.content_ "width=device-width, initial-scale=1"
406:       ]
407:     Lucid.link_ [Lucid.rel_ "stylesheet", Lucid.href_ "/style.css"]
408:     Lucid.script_
409:       [ Lucid.src_ "https://unpkg.com/htmx.org@2.0.4",
410:         Lucid.integrity_ "sha384-HGfztofotfshcF7+8n44JQL2oJmowVChPTg48S+jvZoztPfvwD79OC/LTtG6dMp+",
411:         Lucid.crossorigin_ "anonymous"
412:       ]
413:       ("" :: Text)
414:     Lucid.script_ [] statusDropdownJs
415:     Lucid.script_ [] priorityDropdownJs
416:     Lucid.script_ [] navbarDropdownJs
417: 
418: navbarDropdownJs :: Text
419: navbarDropdownJs =
420:   Text.unlines
421:     [ "document.addEventListener('DOMContentLoaded', function() {",
422:       "  document.querySelectorAll('.navbar-dropdown-btn').forEach(function(btn) {",
423:       "    btn.addEventListener('click', function(e) {",
424:       "      e.preventDefault();",
425:       "      var dropdown = btn.closest('.navbar-dropdown');",
426:       "      var isOpen = dropdown.classList.contains('open');",
427:       "      document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
428:       "        d.classList.remove('open');",
429:       "      });",
430:       "      if (!isOpen) {",
431:       "        dropdown.classList.add('open');",
432:       "      }",
433:       "    });",
434:       "  });",
435:       "  document.addEventListener('click', function(e) {",
436:       "    if (!e.target.closest('.navbar-dropdown')) {",
437:       "      document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
438:       "        d.classList.remove('open');",
439:       "      });",
440:       "    }",
441:       "  });",
442:       "});"
443:     ]
444: 
445: statusDropdownJs :: Text
446: statusDropdownJs =
447:   Text.unlines
448:     [ "function toggleStatusDropdown(el) {",
449:       "  var container = el.parentElement;",
450:       "  var isOpen = container.classList.toggle('open');",
451:       "  el.setAttribute('aria-expanded', isOpen);",
452:       "  if (isOpen) {",
453:       "    var firstItem = container.querySelector('[role=\"menuitem\"]');",
454:       "    if (firstItem) firstItem.focus();",
455:       "  }",
456:       "}",
457:       "",
458:       "function closeStatusDropdown(container) {",
459:       "  container.classList.remove('open');",
460:       "  var badge = container.querySelector('[role=\"button\"]');",
461:       "  if (badge) {",
462:       "    badge.setAttribute('aria-expanded', 'false');",
463:       "    badge.focus();",
464:       "  }",
465:       "}",
466:       "",
467:       "function handleStatusKeydown(event, el) {",
468:       "  if (event.key === 'Enter' || event.key === ' ') {",
469:       "    event.preventDefault();",
470:       "    toggleStatusDropdown(el);",
471:       "  } else if (event.key === 'Escape') {",
472:       "    closeStatusDropdown(el.parentElement);",
473:       "  } else if (event.key === 'ArrowDown') {",
474:       "    event.preventDefault();",
475:       "    var container = el.parentElement;",
476:       "    if (!container.classList.contains('open')) {",
477:       "      toggleStatusDropdown(el);",
478:       "    } else {",
479:       "      var firstItem = container.querySelector('[role=\"menuitem\"]');",
480:       "      if (firstItem) firstItem.focus();",
481:       "    }",
482:       "  }",
483:       "}",
484:       "",
485:       "function handleMenuItemKeydown(event) {",
486:       "  var container = event.target.closest('.status-badge-dropdown');",
487:       "  var items = container.querySelectorAll('[role=\"menuitem\"]');",
488:       "  var currentIndex = Array.from(items).indexOf(event.target);",
489:       "  ",
490:       "  if (event.key === 'ArrowDown') {",
491:       "    event.preventDefault();",
492:       "    var next = (currentIndex + 1) % items.length;",
493:       "    items[next].focus();",
494:       "  } else if (event.key === 'ArrowUp') {",
495:       "    event.preventDefault();",
496:       "    var prev = (currentIndex - 1 + items.length) % items.length;",
497:       "    items[prev].focus();",
498:       "  } else if (event.key === 'Escape') {",
499:       "    event.preventDefault();",
500:       "    closeStatusDropdown(container);",
501:       "  } else if (event.key === 'Tab') {",
502:       "    closeStatusDropdown(container);",
503:       "  }",
504:       "}",
505:       "",
506:       "document.addEventListener('click', function(e) {",
507:       "  var dropdowns = document.querySelectorAll('.status-badge-dropdown.open');",
508:       "  dropdowns.forEach(function(d) {",
509:       "    if (!d.contains(e.target)) {",
510:       "      closeStatusDropdown(d);",
511:       "    }",
512:       "  });",
513:       "});"
514:     ]
515: 
516: priorityDropdownJs :: Text
517: priorityDropdownJs =
518:   Text.unlines
519:     [ "function togglePriorityDropdown(el) {",
520:       "  var container = el.parentElement;",
521:       "  var isOpen = container.classList.toggle('open');",
522:       "  el.setAttribute('aria-expanded', isOpen);",
523:       "  if (isOpen) {",
524:       "    var firstItem = container.querySelector('[role=\"menuitem\"]');",
525:       "    if (firstItem) firstItem.focus();",
526:       "  }",
527:       "}",
528:       "",
529:       "function closePriorityDropdown(container) {",
530:       "  container.classList.remove('open');",
531:       "  var badge = container.querySelector('[role=\"button\"]');",
532:       "  if (badge) {",
533:       "    badge.setAttribute('aria-expanded', 'false');",
534:       "    badge.focus();",
535:       "  }",
536:       "}",
537:       "",
538:       "function handlePriorityKeydown(event, el) {",
539:       "  if (event.key === 'Enter' || event.key === ' ') {",
540:       "    event.preventDefault();",
541:       "    togglePriorityDropdown(el);",
542:       "  } else if (event.key === 'Escape') {",
543:       "    closePriorityDropdown(el.parentElement);",
544:       "  } else if (event.key === 'ArrowDown') {",
545:       "    event.preventDefault();",
546:       "    var container = el.parentElement;",
547:       "    if (!container.classList.contains('open')) {",
548:       "      togglePriorityDropdown(el);",
549:       "    } else {",
550:       "      var firstItem = container.querySelector('[role=\"menuitem\"]');",
551:       "      if (firstItem) firstItem.focus();",
552:       "    }",
553:       "  }",
554:       "}",
555:       "",
556:       "function handlePriorityMenuItemKeydown(event) {",
557:       "  var container = event.target.closest('.priority-badge-dropdown');",
558:       "  var items = container.querySelectorAll('[role=\"menuitem\"]');",
559:       "  var currentIndex = Array.from(items).indexOf(event.target);",
560:       "  ",
561:       "  if (event.key === 'ArrowDown') {",
562:       "    event.preventDefault();",
563:       "    var next = (currentIndex + 1) % items.length;",
564:       "    items[next].focus();",
565:       "  } else if (event.key === 'ArrowUp') {",
566:       "    event.preventDefault();",
567:       "    var prev = (currentIndex - 1 + items.length) % items.length;",
568:       "    items[prev].focus();",
569:       "  } else if (event.key === 'Escape') {",
570:       "    event.preventDefault();",
571:       "    closePriorityDropdown(container);",
572:       "  } else if (event.key === 'Tab') {",
573:       "    closePriorityDropdown(container);",
574:       "  }",
575:       "}",
576:       "",
577:       "document.addEventListener('click', function(e) {",
578:       "  var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
579:       "  dropdowns.forEach(function(d) {",
580:       "    if (!d.contains(e.target)) {",
581:       "      closePriorityDropdown(d);",
582:       "    }",
583:       "  });",
584:       "});"
585:     ]
586: 
587: pageBody :: (Monad m) => Lucid.HtmlT m () -> Lucid.HtmlT m ()
588: pageBody content =
589:   Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
590:     navbar
591:     content
592: 
593: data Breadcrumb = Breadcrumb
594:   { _crumbLabel :: Text,
595:     _crumbHref :: Maybe Text
596:   }
597: 
598: type Breadcrumbs = [Breadcrumb]
599: 
600: pageBodyWithCrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m () -> Lucid.HtmlT m ()
601: pageBodyWithCrumbs crumbs content =
602:   Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
603:     navbar
604:     unless (null crumbs) <| do
605:       Lucid.div_ [Lucid.class_ "breadcrumb-container"] <| do
606:         Lucid.div_ [Lucid.class_ "container"] <| renderBreadcrumbs crumbs
607:     content
608: 
609: renderBreadcrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m ()
610: renderBreadcrumbs [] = pure ()
611: renderBreadcrumbs crumbs =
612:   Lucid.nav_ [Lucid.class_ "breadcrumbs", Lucid.makeAttribute "aria-label" "Breadcrumb"] <| do
613:     Lucid.ol_ [Lucid.class_ "breadcrumb-list"] <| do
614:       traverse_ renderCrumb (zip [0 ..] crumbs)
615:   where
616:     renderCrumb :: (Monad m') => (Int, Breadcrumb) -> Lucid.HtmlT m' ()
617:     renderCrumb (idx, Breadcrumb label mHref) = do
618:       Lucid.li_ [Lucid.class_ "breadcrumb-item"] <| do
619:         when (idx > 0) <| Lucid.span_ [Lucid.class_ "breadcrumb-sep"] ">"
620:         case mHref of
621:           Just href -> Lucid.a_ [Lucid.href_ href] (Lucid.toHtml label)
622:           Nothing -> Lucid.span_ [Lucid.class_ "breadcrumb-current"] (Lucid.toHtml label)
623: 
624: getAncestors :: [TaskCore.Task] -> TaskCore.Task -> [TaskCore.Task]
625: getAncestors allTasks task =
626:   case TaskCore.taskParent task of
627:     Nothing -> [task]
628:     Just pid -> case TaskCore.findTask pid allTasks of
629:       Nothing -> [task]
630:       Just parent -> getAncestors allTasks parent ++ [task]
631: 
632: taskBreadcrumbs :: [TaskCore.Task] -> TaskCore.Task -> Breadcrumbs
633: taskBreadcrumbs allTasks task =
634:   let ancestors = getAncestors allTasks task
635:       taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
636:       currentCrumb = Breadcrumb (TaskCore.taskId task) Nothing
637:    in [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks")]
638:         ++ taskCrumbs
639:         ++ [currentCrumb]
640: 
641: navbar :: (Monad m) => Lucid.HtmlT m ()
642: navbar =
643:   Lucid.nav_ [Lucid.class_ "navbar"] <| do
644:     Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Junior"
645:     Lucid.input_
646:       [ Lucid.type_ "checkbox",
647:         Lucid.id_ "navbar-toggle",
648:         Lucid.class_ "navbar-toggle-checkbox"
649:       ]
650:     Lucid.label_
651:       [ Lucid.for_ "navbar-toggle",
652:         Lucid.class_ "navbar-hamburger"
653:       ]
654:       <| do
655:         Lucid.span_ [Lucid.class_ "hamburger-line"] ""
656:         Lucid.span_ [Lucid.class_ "hamburger-line"] ""
657:         Lucid.span_ [Lucid.class_ "hamburger-line"] ""
658:     Lucid.div_ [Lucid.class_ "navbar-links"] <| do
659:       Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
660:       Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
661:         Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Tasks ▾"
662:         Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
663:           Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
664:           Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
665:           Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Human Action"
666:           Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
667:       Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
668:         Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
669:         Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
670:           Lucid.a_ [Lucid.href_ "/epics", Lucid.class_ "navbar-dropdown-item"] "Epics"
671:           Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
672:       Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
673: 
674: statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675: statusBadge status =
676:   let (cls, label) = case status of
677:         TaskCore.Draft -> ("badge badge-draft", "Draft")
678:         TaskCore.Open -> ("badge badge-open", "Open")
679:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
680:         TaskCore.Review -> ("badge badge-review", "Review")
681:         TaskCore.Approved -> ("badge badge-approved", "Approved")
682:         TaskCore.Done -> ("badge badge-done", "Done")
683:    in Lucid.span_ [Lucid.class_ cls] label
684: 
685: sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
686: sortDropdown basePath currentSort =
687:   Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
688:     Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
689:     Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
690:       Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
691:         <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
692:       Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
693:         sortOption basePath SortNewest currentSort
694:         sortOption basePath SortOldest currentSort
695:         sortOption basePath SortUpdated currentSort
696:         sortOption basePath SortPriorityHigh currentSort
697:         sortOption basePath SortPriorityLow currentSort
698: 
699: sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
700: sortOption basePath option currentSort =
701:   let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
702:       href = basePath <> "?sort=" <> sortOrderToParam option
703:    in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
704: 
705: multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
706: multiColorProgressBar stats =
707:   let total = TaskCore.totalTasks stats
708:       doneCount = TaskCore.doneTasks stats
709:       inProgressCount = TaskCore.inProgressTasks stats
710:       openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
711:       donePct = if total == 0 then 0 else (doneCount * 100) `div` total
712:       inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
713:       openPct = if total == 0 then 0 else (openCount * 100) `div` total
714:    in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
715:         Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
716:           when (donePct > 0)
717:             <| Lucid.div_
718:               [ Lucid.class_ "multi-progress-segment progress-done",
719:                 Lucid.style_ ("width: " <> tshow donePct <> "%"),
720:                 Lucid.title_ (tshow doneCount <> " done")
721:               ]
722:               ""
723:           when (inProgressPct > 0)
724:             <| Lucid.div_
725:               [ Lucid.class_ "multi-progress-segment progress-inprogress",
726:                 Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
727:                 Lucid.title_ (tshow inProgressCount <> " in progress")
728:               ]
729:               ""
730:           when (openPct > 0)
731:             <| Lucid.div_
732:               [ Lucid.class_ "multi-progress-segment progress-open",
733:                 Lucid.style_ ("width: " <> tshow openPct <> "%"),
734:                 Lucid.title_ (tshow openCount <> " open")
735:               ]
736:               ""
737:         Lucid.div_ [Lucid.class_ "progress-legend"] <| do
738:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
739:             Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
740:             Lucid.toHtml ("Done " <> tshow doneCount)
741:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
742:             Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
743:             Lucid.toHtml ("In Progress " <> tshow inProgressCount)
744:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
745:             Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
746:             Lucid.toHtml ("Open " <> tshow openCount)
747: 
748: statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
749: statusBadgeWithForm status tid =
750:   Lucid.div_
751:     [ Lucid.id_ "status-badge-container",
752:       Lucid.class_ "status-badge-dropdown"
753:     ]
754:     <| do
755:       clickableBadge status tid
756:       statusDropdownOptions status tid
757: 
758: clickableBadge :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
759: clickableBadge status _tid =
760:   let (cls, label) = case status of
761:         TaskCore.Draft -> ("badge badge-draft status-badge-clickable", "Draft" :: Text)
762:         TaskCore.Open -> ("badge badge-open status-badge-clickable", "Open")
763:         TaskCore.InProgress -> ("badge badge-inprogress status-badge-clickable", "In Progress")
764:         TaskCore.Review -> ("badge badge-review status-badge-clickable", "Review")
765:         TaskCore.Approved -> ("badge badge-approved status-badge-clickable", "Approved")
766:         TaskCore.Done -> ("badge badge-done status-badge-clickable", "Done")
767:    in Lucid.span_
768:         [ Lucid.class_ cls,
769:           Lucid.tabindex_ "0",
770:           Lucid.role_ "button",
771:           Lucid.makeAttribute "aria-haspopup" "true",
772:           Lucid.makeAttribute "aria-expanded" "false",
773:           Lucid.makeAttribute "onclick" "toggleStatusDropdown(this)",
774:           Lucid.makeAttribute "onkeydown" "handleStatusKeydown(event, this)"
775:         ]
776:         <| do
777:           Lucid.toHtml label
778:           Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
779: 
780: statusDropdownOptions :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
781: statusDropdownOptions currentStatus tid =
782:   Lucid.div_
783:     [ Lucid.class_ "status-dropdown-menu",
784:       Lucid.role_ "menu",
785:       Lucid.makeAttribute "aria-label" "Change task status"
786:     ]
787:     <| do
788:       statusOption TaskCore.Draft currentStatus tid
789:       statusOption TaskCore.Open currentStatus tid
790:       statusOption TaskCore.InProgress currentStatus tid
791:       statusOption TaskCore.Review currentStatus tid
792:       statusOption TaskCore.Approved currentStatus tid
793:       statusOption TaskCore.Done currentStatus tid
794: 
795: statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Text -> Lucid.HtmlT m ()
796: statusOption opt currentStatus tid =
797:   let (cls, label) = case opt of
798:         TaskCore.Draft -> ("badge badge-draft", "Draft" :: Text)
799:         TaskCore.Open -> ("badge badge-open", "Open")
800:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
801:         TaskCore.Review -> ("badge badge-review", "Review")
802:         TaskCore.Approved -> ("badge badge-approved", "Approved")
803:         TaskCore.Done -> ("badge badge-done", "Done")
804:       isSelected = opt == currentStatus
805:       optClass = cls <> " status-dropdown-option" <> if isSelected then " selected" else ""
806:    in Lucid.form_
807:         [ Lucid.class_ "status-option-form",
808:           Lucid.role_ "none",
809:           Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
810:           Lucid.makeAttribute "hx-target" "#status-badge-container",
811:           Lucid.makeAttribute "hx-swap" "outerHTML"
812:         ]
813:         <| do
814:           Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ (tshow opt)]
815:           Lucid.button_
816:             [ Lucid.type_ "submit",
817:               Lucid.class_ optClass,
818:               Lucid.role_ "menuitem",
819:               Lucid.tabindex_ "-1",
820:               Lucid.makeAttribute "onkeydown" "handleMenuItemKeydown(event)"
821:             ]
822:             (Lucid.toHtml label)
823: 
824: priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
825: priorityBadgeWithForm priority tid =
826:   Lucid.div_
827:     [ Lucid.id_ "priority-badge-container",
828:       Lucid.class_ "priority-badge-dropdown"
829:     ]
830:     <| do
831:       clickablePriorityBadge priority tid
832:       priorityDropdownOptions priority tid
833: 
834: clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
835: clickablePriorityBadge priority _tid =
836:   let (cls, label) = case priority of
837:         TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
838:         TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
839:         TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
840:         TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
841:         TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
842:    in Lucid.span_
843:         [ Lucid.class_ cls,
844:           Lucid.tabindex_ "0",
845:           Lucid.role_ "button",
846:           Lucid.makeAttribute "aria-haspopup" "true",
847:           Lucid.makeAttribute "aria-expanded" "false",
848:           Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
849:           Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
850:         ]
851:         <| do
852:           Lucid.toHtml label
853:           Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
854: 
855: priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
856: priorityDropdownOptions currentPriority tid =
857:   Lucid.div_
858:     [ Lucid.class_ "priority-dropdown-menu",
859:       Lucid.role_ "menu",
860:       Lucid.makeAttribute "aria-label" "Change task priority"
861:     ]
862:     <| do
863:       priorityOption TaskCore.P0 currentPriority tid
864:       priorityOption TaskCore.P1 currentPriority tid
865:       priorityOption TaskCore.P2 currentPriority tid
866:       priorityOption TaskCore.P3 currentPriority tid
867:       priorityOption TaskCore.P4 currentPriority tid
868: 
869: priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
870: priorityOption opt currentPriority tid =
871:   let (cls, label) = case opt of
872:         TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
873:         TaskCore.P1 -> ("badge badge-p1", "P1 High")
874:         TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
875:         TaskCore.P3 -> ("badge badge-p3", "P3 Low")
876:         TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
877:       isSelected = opt == currentPriority
878:       optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
879:    in Lucid.form_
880:         [ Lucid.class_ "priority-option-form",
881:           Lucid.role_ "none",
882:           Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
883:           Lucid.makeAttribute "hx-target" "#priority-badge-container",
884:           Lucid.makeAttribute "hx-swap" "outerHTML"
885:         ]
886:         <| do
887:           Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
888:           Lucid.button_
889:             [ Lucid.type_ "submit",
890:               Lucid.class_ optClass,
891:               Lucid.role_ "menuitem",
892:               Lucid.tabindex_ "-1",
893:               Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
894:             ]
895:             (Lucid.toHtml label)
896: 
897: renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
898: renderTaskCard t =
899:   Lucid.a_
900:     [ Lucid.class_ "task-card task-card-link",
901:       Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
902:     ]
903:     <| do
904:       Lucid.div_ [Lucid.class_ "task-header"] <| do
905:         Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
906:         statusBadge (TaskCore.taskStatus t)
907:         Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
908:       Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
909: 
910: renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
911: renderBlockedTaskCard (t, impact) =
912:   Lucid.a_
913:     [ Lucid.class_ "task-card task-card-link",
914:       Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
915:     ]
916:     <| do
917:       Lucid.div_ [Lucid.class_ "task-header"] <| do
918:         Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
919:         statusBadge (TaskCore.taskStatus t)
920:         Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
921:         when (impact > 0)
922:           <| Lucid.span_ [Lucid.class_ "blocking-impact"] (Lucid.toHtml ("Blocks " <> tshow impact))
923:       Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
924: 
925: renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
926: renderListGroupItem t =
927:   Lucid.a_
928:     [ Lucid.class_ "list-group-item",
929:       Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
930:     ]
931:     <| do
932:       Lucid.div_ [Lucid.class_ "list-group-item-content"] <| do
933:         Lucid.span_ [Lucid.class_ "list-group-item-id"] (Lucid.toHtml (TaskCore.taskId t))
934:         Lucid.span_ [Lucid.class_ "list-group-item-title"] (Lucid.toHtml (TaskCore.taskTitle t))
935:       Lucid.div_ [Lucid.class_ "list-group-item-meta"] <| do
936:         statusBadge (TaskCore.taskStatus t)
937:         Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
938: 
939: instance Lucid.ToHtml HomePage where
940:   toHtmlRaw = Lucid.toHtml
941:   toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics currentRange _now) =
942:     Lucid.doctypehtml_ <| do
943:       pageHead "Jr Dashboard"
944:       pageBody <| do
945:         Lucid.div_ [Lucid.class_ "container"] <| do
946:           Lucid.h2_ "Task Status"
947:           Lucid.div_ [Lucid.class_ "time-filter"] <| do
948:             timeFilterBtn "Today" Today currentRange
949:             timeFilterBtn "This Week" Week currentRange
950:             timeFilterBtn "This Month" Month currentRange
951:             timeFilterBtn "All Time" AllTime currentRange
952:           Lucid.div_ [Lucid.class_ "stats-grid"] <| do
953:             statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open"
954:             statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress"
955:             statCard "Review" (TaskCore.reviewTasks stats) "badge-review" "/tasks?status=Review"
956:             statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" "/tasks?status=Approved"
957:             statCard "Done" (TaskCore.doneTasks stats) "badge-done" "/tasks?status=Done"
958:             metricCard "Cost" (formatCost (TaskCore.aggTotalCostCents globalMetrics))
959:             metricCard "Duration" (formatDuration (TaskCore.aggTotalDurationSeconds globalMetrics))
960: 
961:           Lucid.h2_ <| do
962:             "Ready Queue "
963:             Lucid.span_
964:               [ Lucid.class_ "ready-count",
965:                 Lucid.makeAttribute "hx-get" "/partials/ready-count",
966:                 Lucid.makeAttribute "hx-trigger" "every 5s"
967:               ]
968:               <| do
969:                 Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
970:                   <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)")
971:           if null readyTasks
972:             then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work."
973:             else
974:               Lucid.div_ [Lucid.class_ "list-group"]
975:                 <| traverse_ renderListGroupItem (take 5 readyTasks)
976: 
977:           Lucid.h2_ "Recent Activity"
978:           let newestTimestamp = maybe 0 taskToUnixTs (head recentTasks)
979:           Lucid.div_
980:             [ Lucid.class_ "recent-activity",
981:               Lucid.id_ "recent-activity",
982:               Lucid.makeAttribute "data-newest-ts" (tshow newestTimestamp),
983:               Lucid.makeAttribute "hx-get" "/partials/recent-activity-new",
984:               Lucid.makeAttribute "hx-trigger" "every 10s",
985:               Lucid.makeAttribute "hx-vals" "js:{since: this.dataset.newestTs}",
986:               Lucid.makeAttribute "hx-target" "#activity-list",
987:               Lucid.makeAttribute "hx-swap" "afterbegin"
988:             ]
989:             <| do
990:               Lucid.div_ [Lucid.id_ "activity-list", Lucid.class_ "list-group"]
991:                 <| traverse_ renderListGroupItem recentTasks
992:               when hasMoreRecent
993:                 <| Lucid.button_
994:                   [ Lucid.id_ "activity-load-more",
995:                     Lucid.class_ "btn btn-secondary load-more-btn",
996:                     Lucid.makeAttribute "hx-get" "/partials/recent-activity-more?offset=5",
997:                     Lucid.makeAttribute "hx-target" "#activity-list",
998:                     Lucid.makeAttribute "hx-swap" "beforeend"
999:                   ]
1000:                   "Load More"
1001:     where
1002:       statCard :: (Monad m) => Text -> Int -> Text -> Text -> Lucid.HtmlT m ()
1003:       statCard label count badgeClass href =
1004:         Lucid.a_ [Lucid.href_ href, Lucid.class_ ("stat-card " <> badgeClass)] <| do
1005:           Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
1006:           Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
1007: 
1008:       metricCard :: (Monad m) => Text -> Text -> Lucid.HtmlT m ()
1009:       metricCard label value =
1010:         Lucid.div_ [Lucid.class_ "stat-card badge-neutral"] <| do
1011:           Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml value)
1012:           Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
1013: 
1014:       formatCost :: Int -> Text
1015:       formatCost cents =
1016:         let dollars = fromIntegral cents / 100.0 :: Double
1017:          in Text.pack ("$" <> showFFloat (Just 2) dollars "")
1018: 
1019:       formatDuration :: Int -> Text
1020:       formatDuration totalSeconds
1021:         | totalSeconds < 60 = tshow totalSeconds <> "s"
1022:         | totalSeconds < 3600 =
1023:             let mins = totalSeconds `div` 60
1024:              in tshow mins <> "m"
1025:         | otherwise =
1026:             let hours = totalSeconds `div` 3600
1027:                 mins = (totalSeconds `mod` 3600) `div` 60
1028:              in tshow hours <> "h " <> tshow mins <> "m"
1029: 
1030:       timeFilterBtn :: (Monad m) => Text -> TimeRange -> TimeRange -> Lucid.HtmlT m ()
1031:       timeFilterBtn label range current =
1032:         let activeClass = if range == current then " active" else ""
1033:             href = "/?" <> "range=" <> timeRangeToParam range
1034:          in Lucid.a_
1035:               [ Lucid.href_ href,
1036:                 Lucid.class_ ("time-filter-btn" <> activeClass)
1037:               ]
1038:               (Lucid.toHtml label)
1039: 
1040: instance Lucid.ToHtml ReadyQueuePage where
1041:   toHtmlRaw = Lucid.toHtml
1042:   toHtml (ReadyQueuePage tasks currentSort _now) =
1043:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Ready Queue" Nothing]
1044:      in Lucid.doctypehtml_ <| do
1045:           pageHead "Ready Queue - Jr"
1046:           pageBodyWithCrumbs crumbs <| do
1047:             Lucid.div_ [Lucid.class_ "container"] <| do
1048:               Lucid.div_ [Lucid.class_ "page-header-row"] <| do
1049:                 Lucid.h1_ <| Lucid.toHtml ("Ready Queue (" <> tshow (length tasks) <> " tasks)")
1050:                 sortDropdown "/ready" currentSort
1051:               if null tasks
1052:                 then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks are ready for work."
1053:                 else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks
1054: 
1055: instance Lucid.ToHtml BlockedPage where
1056:   toHtmlRaw = Lucid.toHtml
1057:   toHtml (BlockedPage tasksWithImpact currentSort _now) =
1058:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Blocked" Nothing]
1059:      in Lucid.doctypehtml_ <| do
1060:           pageHead "Blocked Tasks - Jr"
1061:           pageBodyWithCrumbs crumbs <| do
1062:             Lucid.div_ [Lucid.class_ "container"] <| do
1063:               Lucid.div_ [Lucid.class_ "page-header-row"] <| do
1064:                 Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasksWithImpact) <> " tasks)")
1065:                 sortDropdown "/blocked" currentSort
1066:               Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies, sorted by blocking impact."
1067:               if null tasksWithImpact
1068:                 then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
1069:                 else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderBlockedTaskCard tasksWithImpact
1070: 
1071: instance Lucid.ToHtml InterventionPage where
1072:   toHtmlRaw = Lucid.toHtml
1073:   toHtml (InterventionPage actionItems currentSort _now) =
1074:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Human Action" Nothing]
1075:         failed = TaskCore.failedTasks actionItems
1076:         epicsReady = TaskCore.epicsInReview actionItems
1077:         human = TaskCore.humanTasks actionItems
1078:         totalCount = length failed + length epicsReady + length human
1079:      in Lucid.doctypehtml_ <| do
1080:           pageHead "Needs Human Action - Jr"
1081:           pageBodyWithCrumbs crumbs <| do
1082:             Lucid.div_ [Lucid.class_ "container"] <| do
1083:               Lucid.div_ [Lucid.class_ "page-header-row"] <| do
1084:                 Lucid.h1_ <| Lucid.toHtml ("Needs Human Action (" <> tshow totalCount <> " items)")
1085:                 sortDropdown "/intervention" currentSort
1086:               if totalCount == 0
1087:                 then Lucid.p_ [Lucid.class_ "empty-msg"] "No items need human action."
1088:                 else do
1089:                   unless (null failed) <| do
1090:                     Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Failed Tasks (" <> tshow (length failed) <> ")")
1091:                     Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help."
1092:                     Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort failed)
1093:                   unless (null epicsReady) <| do
1094:                     Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Epics Ready for Review (" <> tshow (length epicsReady) <> ")")
1095:                     Lucid.p_ [Lucid.class_ "info-msg"] "Epics with all children completed. Verify before closing."
1096:                     Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicReviewCard epicsReady
1097:                   unless (null human) <| do
1098:                     Lucid.h2_ [Lucid.class_ "section-header"] <| Lucid.toHtml ("Human Tasks (" <> tshow (length human) <> ")")
1099:                     Lucid.p_ [Lucid.class_ "info-msg"] "Tasks explicitly marked as needing human work."
1100:                     Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (sortTasks currentSort human)
1101: 
1102: renderEpicReviewCard :: (Monad m) => TaskCore.EpicForReview -> Lucid.HtmlT m ()
1103: renderEpicReviewCard epicReview = do
1104:   let task = TaskCore.epicTask epicReview
1105:       total = TaskCore.epicTotal epicReview
1106:       completed = TaskCore.epicCompleted epicReview
1107:       progressText = tshow completed <> "/" <> tshow total <> " subtasks done"
1108:   Lucid.div_ [Lucid.class_ "task-card"] <| do
1109:     Lucid.div_ [Lucid.class_ "task-card-header"] <| do
1110:       Lucid.div_ [Lucid.class_ "task-title-row"] <| do
1111:         Lucid.a_
1112:           [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
1113:           <| Lucid.toHtml (TaskCore.taskTitle task)
1114:         Lucid.span_ [Lucid.class_ "badge badge-epic"] "Epic"
1115:       Lucid.span_ [Lucid.class_ "task-id"] <| Lucid.toHtml (TaskCore.taskId task)
1116:     Lucid.div_ [Lucid.class_ "task-card-body"] <| do
1117:       Lucid.div_ [Lucid.class_ "progress-info"] <| do
1118:         Lucid.span_ [Lucid.class_ "badge badge-success"] <| Lucid.toHtml progressText
1119:       Lucid.div_ [Lucid.class_ "epic-actions"] <| do
1120:         Lucid.form_
1121:           [ Lucid.method_ "POST",
1122:             Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
1123:             Lucid.class_ "inline-form"
1124:           ]
1125:           <| do
1126:             Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ "done"]
1127:             Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-success btn-sm"] "Approve & Close"
1128: 
1129: instance Lucid.ToHtml KBPage where
1130:   toHtmlRaw = Lucid.toHtml
1131:   toHtml (KBPage facts) =
1132:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" Nothing]
1133:      in Lucid.doctypehtml_ <| do
1134:           pageHead "Knowledge Base - Jr"
1135:           pageBodyWithCrumbs crumbs <| do
1136:             Lucid.div_ [Lucid.class_ "container"] <| do
1137:               Lucid.h1_ "Knowledge Base"
1138:               Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution."
1139: 
1140:               Lucid.details_ [Lucid.class_ "create-fact-section"] <| do
1141:                 Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact"
1142:                 Lucid.form_
1143:                   [ Lucid.method_ "POST",
1144:                     Lucid.action_ "/kb/create",
1145:                     Lucid.class_ "fact-create-form"
1146:                   ]
1147:                   <| do
1148:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1149:                       Lucid.label_ [Lucid.for_ "project"] "Project:"
1150:                       Lucid.input_
1151:                         [ Lucid.type_ "text",
1152:                           Lucid.name_ "project",
1153:                           Lucid.id_ "project",
1154:                           Lucid.class_ "form-input",
1155:                           Lucid.required_ "required",
1156:                           Lucid.placeholder_ "e.g., Omni/Jr"
1157:                         ]
1158:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1159:                       Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
1160:                       Lucid.textarea_
1161:                         [ Lucid.name_ "content",
1162:                           Lucid.id_ "content",
1163:                           Lucid.class_ "form-textarea",
1164:                           Lucid.rows_ "4",
1165:                           Lucid.required_ "required",
1166:                           Lucid.placeholder_ "Describe the fact or knowledge..."
1167:                         ]
1168:                         ""
1169:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1170:                       Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
1171:                       Lucid.input_
1172:                         [ Lucid.type_ "text",
1173:                           Lucid.name_ "files",
1174:                           Lucid.id_ "files",
1175:                           Lucid.class_ "form-input",
1176:                           Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs"
1177:                         ]
1178:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1179:                       Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
1180:                       Lucid.input_
1181:                         [ Lucid.type_ "number",
1182:                           Lucid.name_ "confidence",
1183:                           Lucid.id_ "confidence",
1184:                           Lucid.class_ "form-input",
1185:                           Lucid.step_ "0.1",
1186:                           Lucid.min_ "0",
1187:                           Lucid.max_ "1",
1188:                           Lucid.value_ "0.8"
1189:                         ]
1190:                     Lucid.div_ [Lucid.class_ "form-actions"] <| do
1191:                       Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact"
1192: 
1193:               if null facts
1194:                 then Lucid.p_ [Lucid.class_ "empty-msg"] "No facts recorded yet."
1195:                 else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderFactCard facts
1196:     where
1197:       renderFactCard :: (Monad m) => TaskCore.Fact -> Lucid.HtmlT m ()
1198:       renderFactCard f =
1199:         let factUrl = "/kb/" <> maybe "-" tshow (TaskCore.factId f)
1200:          in Lucid.a_
1201:               [ Lucid.class_ "task-card task-card-link",
1202:                 Lucid.href_ factUrl
1203:               ]
1204:               <| do
1205:                 Lucid.div_ [Lucid.class_ "task-header"] <| do
1206:                   Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (maybe "-" tshow (TaskCore.factId f)))
1207:                   confidenceBadge (TaskCore.factConfidence f)
1208:                   Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (TaskCore.factProject f))
1209:                 Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (Text.take 80 (TaskCore.factContent f) <> if Text.length (TaskCore.factContent f) > 80 then "..." else ""))
1210:                 unless (null (TaskCore.factRelatedFiles f)) <| do
1211:                   Lucid.p_ [Lucid.class_ "kb-files"] <| do
1212:                     Lucid.span_ [Lucid.class_ "files-label"] "Files: "
1213:                     Lucid.toHtml (Text.intercalate ", " (take 3 (TaskCore.factRelatedFiles f)))
1214:                     when (length (TaskCore.factRelatedFiles f) > 3) <| do
1215:                       Lucid.toHtml (" +" <> tshow (length (TaskCore.factRelatedFiles f) - 3) <> " more")
1216: 
1217:       confidenceBadge :: (Monad m) => Double -> Lucid.HtmlT m ()
1218:       confidenceBadge conf =
1219:         let pct = floor (conf * 100) :: Int
1220:             cls
1221:               | conf >= 0.8 = "badge badge-done"
1222:               | conf >= 0.5 = "badge badge-inprogress"
1223:               | otherwise = "badge badge-open"
1224:          in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))
1225: 
1226: instance Lucid.ToHtml FactDetailPage where
1227:   toHtmlRaw = Lucid.toHtml
1228:   toHtml (FactDetailNotFound fid) =
1229:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> tshow fid) Nothing]
1230:      in Lucid.doctypehtml_ <| do
1231:           pageHead "Fact Not Found - Jr"
1232:           pageBodyWithCrumbs crumbs <| do
1233:             Lucid.div_ [Lucid.class_ "container"] <| do
1234:               Lucid.h1_ "Fact Not Found"
1235:               Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found."))
1236:               Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base"
1237:   toHtml (FactDetailFound fact now) =
1238:     let fid' = maybe "-" tshow (TaskCore.factId fact)
1239:         crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> fid') Nothing]
1240:      in Lucid.doctypehtml_ <| do
1241:           pageHead "Fact Detail - Jr"
1242:           pageBodyWithCrumbs crumbs <| do
1243:             Lucid.div_ [Lucid.class_ "container"] <| do
1244:               Lucid.div_ [Lucid.class_ "task-detail-header"] <| do
1245:                 Lucid.h1_ <| do
1246:                   Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact)))
1247:                 Lucid.div_ [Lucid.class_ "task-meta-row"] <| do
1248:                   Lucid.span_ [Lucid.class_ "meta-label"] "Project:"
1249:                   Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact))
1250:                   Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:"
1251:                   confidenceBadgeDetail (TaskCore.factConfidence fact)
1252:                   Lucid.span_ [Lucid.class_ "meta-label"] "Created:"
1253:                   Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact))
1254: 
1255:               Lucid.div_ [Lucid.class_ "detail-section"] <| do
1256:                 Lucid.h2_ "Content"
1257:                 Lucid.form_
1258:                   [ Lucid.method_ "POST",
1259:                     Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/edit"),
1260:                     Lucid.class_ "fact-edit-form"
1261:                   ]
1262:                   <| do
1263:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1264:                       Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
1265:                       Lucid.textarea_
1266:                         [ Lucid.name_ "content",
1267:                           Lucid.id_ "content",
1268:                           Lucid.class_ "form-textarea",
1269:                           Lucid.rows_ "6"
1270:                         ]
1271:                         (Lucid.toHtml (TaskCore.factContent fact))
1272: 
1273:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1274:                       Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
1275:                       Lucid.input_
1276:                         [ Lucid.type_ "text",
1277:                           Lucid.name_ "files",
1278:                           Lucid.id_ "files",
1279:                           Lucid.class_ "form-input",
1280:                           Lucid.value_ (Text.intercalate ", " (TaskCore.factRelatedFiles fact))
1281:                         ]
1282: 
1283:                     Lucid.div_ [Lucid.class_ "form-group"] <| do
1284:                       Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
1285:                       Lucid.input_
1286:                         [ Lucid.type_ "number",
1287:                           Lucid.name_ "confidence",
1288:                           Lucid.id_ "confidence",
1289:                           Lucid.class_ "form-input",
1290:                           Lucid.step_ "0.1",
1291:                           Lucid.min_ "0",
1292:                           Lucid.max_ "1",
1293:                           Lucid.value_ (tshow (TaskCore.factConfidence fact))
1294:                         ]
1295: 
1296:                     Lucid.div_ [Lucid.class_ "form-actions"] <| do
1297:                       Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save Changes"
1298: 
1299:               case TaskCore.factSourceTask fact of
1300:                 Nothing -> pure ()
1301:                 Just tid -> do
1302:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1303:                     Lucid.h2_ "Source Task"
1304:                     Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid)
1305: 
1306:               Lucid.div_ [Lucid.class_ "detail-section danger-zone"] <| do
1307:                 Lucid.h2_ "Danger Zone"
1308:                 Lucid.form_
1309:                   [ Lucid.method_ "POST",
1310:                     Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/delete"),
1311:                     Lucid.class_ "delete-form",
1312:                     Lucid.makeAttribute "onsubmit" "return confirm('Are you sure you want to delete this fact?');"
1313:                   ]
1314:                   <| do
1315:                     Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-danger"] "Delete Fact"
1316: 
1317:               Lucid.div_ [Lucid.class_ "back-link"] <| do
1318:                 Lucid.a_ [Lucid.href_ "/kb"] "← Back to Knowledge Base"
1319:     where
1320:       confidenceBadgeDetail :: (Monad m) => Double -> Lucid.HtmlT m ()
1321:       confidenceBadgeDetail conf =
1322:         let pct = floor (conf * 100) :: Int
1323:             cls
1324:               | conf >= 0.8 = "badge badge-done"
1325:               | conf >= 0.5 = "badge badge-inprogress"
1326:               | otherwise = "badge badge-open"
1327:          in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))
1328: 
1329: instance Lucid.ToHtml EpicsPage where
1330:   toHtmlRaw = Lucid.toHtml
1331:   toHtml (EpicsPage epics allTasks currentSort) =
1332:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Epics" Nothing]
1333:      in Lucid.doctypehtml_ <| do
1334:           pageHead "Epics - Jr"
1335:           pageBodyWithCrumbs crumbs <| do
1336:             Lucid.div_ [Lucid.class_ "container"] <| do
1337:               Lucid.div_ [Lucid.class_ "page-header-row"] <| do
1338:                 Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")")
1339:                 sortDropdown "/epics" currentSort
1340:               Lucid.p_ [Lucid.class_ "info-msg"] "All epics (large, multi-task projects)."
1341:               if null epics
1342:                 then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found."
1343:                 else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics
1344: 
1345: epicProgressBar :: (Monad m) => Int -> Int -> Int -> Int -> Lucid.HtmlT m ()
1346: epicProgressBar doneCount inProgressCount openCount totalCount =
1347:   let donePct = if totalCount == 0 then 0 else (doneCount * 100) `div` totalCount
1348:       inProgressPct = if totalCount == 0 then 0 else (inProgressCount * 100) `div` totalCount
1349:       openPct = if totalCount == 0 then 0 else (openCount * 100) `div` totalCount
1350:    in Lucid.div_ [Lucid.class_ "multi-progress-container epic-progress"] <| do
1351:         Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
1352:           when (donePct > 0)
1353:             <| Lucid.div_
1354:               [ Lucid.class_ "multi-progress-segment progress-done",
1355:                 Lucid.style_ ("width: " <> tshow donePct <> "%"),
1356:                 Lucid.title_ (tshow doneCount <> " done")
1357:               ]
1358:               ""
1359:           when (inProgressPct > 0)
1360:             <| Lucid.div_
1361:               [ Lucid.class_ "multi-progress-segment progress-inprogress",
1362:                 Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
1363:                 Lucid.title_ (tshow inProgressCount <> " in progress")
1364:               ]
1365:               ""
1366:           when (openPct > 0)
1367:             <| Lucid.div_
1368:               [ Lucid.class_ "multi-progress-segment progress-open",
1369:                 Lucid.style_ ("width: " <> tshow openPct <> "%"),
1370:                 Lucid.title_ (tshow openCount <> " open")
1371:               ]
1372:               ""
1373:         Lucid.div_ [Lucid.class_ "progress-legend"] <| do
1374:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
1375:             Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
1376:             Lucid.toHtml (tshow doneCount)
1377:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
1378:             Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
1379:             Lucid.toHtml (tshow inProgressCount)
1380:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
1381:             Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
1382:             Lucid.toHtml (tshow openCount)
1383: 
1384: renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m ()
1385: renderEpicCardWithStats allTasks t =
1386:   let children = getDescendants allTasks (TaskCore.taskId t)
1387:       openCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Open]
1388:       inProgressCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.InProgress]
1389:       reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review]
1390:       doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done]
1391:       totalCount = length children
1392:       openAndReview = openCount + reviewCount
1393:    in Lucid.a_
1394:         [ Lucid.class_ "task-card task-card-link",
1395:           Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
1396:         ]
1397:         <| do
1398:           Lucid.div_ [Lucid.class_ "task-header"] <| do
1399:             Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
1400:             statusBadge (TaskCore.taskStatus t)
1401:             Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
1402:           Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
1403:           when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount
1404:           unless (Text.null (TaskCore.taskDescription t))
1405:             <| Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 (TaskCore.taskDescription t) <> "..."))
1406: 
1407: getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task]
1408: getDescendants allTasks parentId =
1409:   let children = [c | c <- allTasks, maybe False (TaskCore.matchesId parentId) (TaskCore.taskParent c)]
1410:    in children ++ concatMap (getDescendants allTasks <. TaskCore.taskId) children
1411: 
1412: instance Lucid.ToHtml TaskListPage where
1413:   toHtmlRaw = Lucid.toHtml
1414:   toHtml (TaskListPage tasks filters currentSort _now) =
1415:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" Nothing]
1416:      in Lucid.doctypehtml_ <| do
1417:           pageHead "Tasks - Jr"
1418:           pageBodyWithCrumbs crumbs <| do
1419:             Lucid.div_ [Lucid.class_ "container"] <| do
1420:               Lucid.div_ [Lucid.class_ "page-header-row"] <| do
1421:                 Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")")
1422:                 sortDropdown "/tasks" currentSort
1423: 
1424:               Lucid.div_ [Lucid.class_ "filter-form"] <| do
1425:                 Lucid.form_
1426:                   [ Lucid.method_ "GET",
1427:                     Lucid.action_ "/tasks",
1428:                     Lucid.makeAttribute "hx-get" "/partials/task-list",
1429:                     Lucid.makeAttribute "hx-target" "#task-list",
1430:                     Lucid.makeAttribute "hx-push-url" "/tasks",
1431:                     Lucid.makeAttribute "hx-trigger" "submit, change from:select"
1432:                   ]
1433:                   <| do
1434:                     Lucid.div_ [Lucid.class_ "filter-row"] <| do
1435:                       Lucid.div_ [Lucid.class_ "filter-group"] <| do
1436:                         Lucid.label_ [Lucid.for_ "status"] "Status:"
1437:                         Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do
1438:                           Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All"
1439:                           statusFilterOption TaskCore.Open (filterStatus filters)
1440:                           statusFilterOption TaskCore.InProgress (filterStatus filters)
1441:                           statusFilterOption TaskCore.Review (filterStatus filters)
1442:                           statusFilterOption TaskCore.Approved (filterStatus filters)
1443:                           statusFilterOption TaskCore.Done (filterStatus filters)
1444: 
1445:                       Lucid.div_ [Lucid.class_ "filter-group"] <| do
1446:                         Lucid.label_ [Lucid.for_ "priority"] "Priority:"
1447:                         Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do
1448:                           Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All"
1449:                           priorityFilterOption TaskCore.P0 (filterPriority filters)
1450:                           priorityFilterOption TaskCore.P1 (filterPriority filters)
1451:                           priorityFilterOption TaskCore.P2 (filterPriority filters)
1452:                           priorityFilterOption TaskCore.P3 (filterPriority filters)
1453:                           priorityFilterOption TaskCore.P4 (filterPriority filters)
1454: 
1455:                       Lucid.div_ [Lucid.class_ "filter-group"] <| do
1456:                         Lucid.label_ [Lucid.for_ "namespace"] "Namespace:"
1457:                         Lucid.input_
1458:                           [ Lucid.type_ "text",
1459:                             Lucid.name_ "namespace",
1460:                             Lucid.id_ "namespace",
1461:                             Lucid.class_ "filter-input",
1462:                             Lucid.placeholder_ "e.g. Omni/Jr",
1463:                             Lucid.value_ (fromMaybe "" (filterNamespace filters))
1464:                           ]
1465: 
1466:                       Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
1467:                       Lucid.a_
1468:                         [ Lucid.href_ "/tasks",
1469:                           Lucid.class_ "clear-btn",
1470:                           Lucid.makeAttribute "hx-get" "/partials/task-list",
1471:                           Lucid.makeAttribute "hx-target" "#task-list",
1472:                           Lucid.makeAttribute "hx-push-url" "/tasks"
1473:                         ]
1474:                         "Clear"
1475: 
1476:               Lucid.div_ [Lucid.id_ "task-list"] <| do
1477:                 if null tasks
1478:                   then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
1479:                   else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
1480:     where
1481:       maybeSelected :: (Eq a) => Maybe a -> Maybe a -> [Lucid.Attribute]
1482:       maybeSelected opt current = [Lucid.selected_ "selected" | opt == current]
1483: 
1484:       statusFilterOption :: (Monad m) => TaskCore.Status -> Maybe TaskCore.Status -> Lucid.HtmlT m ()
1485:       statusFilterOption s current =
1486:         let attrs = [Lucid.value_ (tshow s)] <> [Lucid.selected_ "selected" | Just s == current]
1487:          in Lucid.option_ attrs (Lucid.toHtml (tshow s))
1488: 
1489:       priorityFilterOption :: (Monad m) => TaskCore.Priority -> Maybe TaskCore.Priority -> Lucid.HtmlT m ()
1490:       priorityFilterOption p current =
1491:         let attrs = [Lucid.value_ (tshow p)] <> [Lucid.selected_ "selected" | Just p == current]
1492:          in Lucid.option_ attrs (Lucid.toHtml (tshow p))
1493: 
1494: instance Lucid.ToHtml TaskDetailPage where
1495:   toHtmlRaw = Lucid.toHtml
1496:   toHtml (TaskDetailNotFound tid) =
1497:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid Nothing]
1498:      in Lucid.doctypehtml_ <| do
1499:           pageHead "Task Not Found - Jr"
1500:           pageBodyWithCrumbs crumbs <| do
1501:             Lucid.div_ [Lucid.class_ "container"] <| do
1502:               Lucid.h1_ "Task Not Found"
1503:               Lucid.p_ <| do
1504:                 "The task "
1505:                 Lucid.code_ (Lucid.toHtml tid)
1506:                 " could not be found."
1507:   toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics agentEvents now) =
1508:     let crumbs = taskBreadcrumbs allTasks task
1509:      in Lucid.doctypehtml_ <| do
1510:           pageHead (TaskCore.taskId task <> " - Jr")
1511:           pageBodyWithCrumbs crumbs <| do
1512:             Lucid.div_ [Lucid.class_ "container"] <| do
1513:               Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
1514: 
1515:               renderRetryContextBanner (TaskCore.taskId task) maybeRetry
1516: 
1517:               Lucid.div_ [Lucid.class_ "task-detail"] <| do
1518:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1519:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1520:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1521:                     metaSep
1522:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1523:                     metaSep
1524:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                     metaSep
1526:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1527:                     case TaskCore.taskNamespace task of
1528:                       Nothing -> pure ()
1529:                       Just ns -> do
1530:                         metaSep
1531:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
1532: 
1533:                   Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
1534:                     case TaskCore.taskParent task of
1535:                       Nothing -> pure ()
1536:                       Just pid -> do
1537:                         Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
1538:                         Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
1539:                         metaSep
1540:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
1541:                     renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
1542:                     metaSep
1543:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
1544:                     renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
1545: 
1546:                 let deps = TaskCore.taskDependencies task
1547:                 unless (null deps) <| do
1548:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1549:                     Lucid.h3_ "Dependencies"
1550:                     Lucid.ul_ [Lucid.class_ "dep-list"] <| do
1551:                       traverse_ renderDependency deps
1552: 
1553:                 when (TaskCore.taskType task == TaskCore.Epic) <| do
1554:                   for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
1555: 
1556:                 Lucid.div_ [Lucid.class_ "detail-section"] <| do
1557:                   Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
1558: 
1559:                 let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
1560:                 unless (null children) <| do
1561:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1562:                     Lucid.h3_ "Child Tasks"
1563:                     Lucid.ul_ [Lucid.class_ "child-list"] <| do
1564:                       traverse_ renderChild children
1565: 
1566:                 unless (null commits) <| do
1567:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1568:                     Lucid.h3_ "Git Commits"
1569:                     Lucid.div_ [Lucid.class_ "commit-list"] <| do
1570:                       traverse_ (renderCommit (TaskCore.taskId task)) commits
1571: 
1572:               let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities
1573:               when hasRunningActivity <| do
1574:                 let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress
1575:                     htmxAttrs =
1576:                       [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> TaskCore.taskId task <> "/metrics"),
1577:                         Lucid.makeAttribute "hx-trigger" "every 5s",
1578:                         Lucid.makeAttribute "hx-swap" "innerHTML"
1579:                       ]
1580:                     innerAttrs =
1581:                       [Lucid.id_ "execution-details-inner"]
1582:                         <> [attr | isInProgress, attr <- htmxAttrs]
1583:                 Lucid.div_ [Lucid.class_ "execution-section"] <| do
1584:                   Lucid.h3_ "Execution Details"
1585:                   Lucid.div_ innerAttrs <| renderExecutionDetails (TaskCore.taskId task) activities maybeRetry
1586: 
1587:               when (TaskCore.taskStatus task == TaskCore.Review) <| do
1588:                 Lucid.div_ [Lucid.class_ "review-link-section"] <| do
1589:                   Lucid.a_
1590:                     [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
1591:                       Lucid.class_ "review-link-btn"
1592:                     ]
1593:                     "Review This Task"
1594: 
1595:               renderUnifiedTimeline (TaskCore.taskId task) (TaskCore.taskComments task) agentEvents (TaskCore.taskStatus task) now
1596:     where
1597:       renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
1598:       renderDependency dep =
1599:         Lucid.li_ <| do
1600:           Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
1601:           Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]")
1602: 
1603:       renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
1604:       renderChild child =
1605:         Lucid.li_ <| do
1606:           Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
1607:           Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
1608:           Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")
1609: 
1610:       renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m ()
1611:       renderCommit tid c =
1612:         Lucid.div_ [Lucid.class_ "commit-item"] <| do
1613:           Lucid.div_ [Lucid.class_ "commit-header"] <| do
1614:             Lucid.a_
1615:               [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
1616:                 Lucid.class_ "commit-hash"
1617:               ]
1618:               (Lucid.toHtml (commitShortHash c))
1619:             Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c))
1620:           Lucid.div_ [Lucid.class_ "commit-meta"] <| do
1621:             Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c))
1622:             Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c))
1623:             Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files"))
1624: 
1625:       renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
1626:       renderExecutionDetails _ acts retryCtx =
1627:         let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) acts
1628:          in if null runningActs
1629:               then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
1630:               else
1631:                 Lucid.div_ [Lucid.class_ "execution-details"] <| do
1632:                   let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
1633:                       totalDuration = sum [calcDurSecs act | act <- runningActs]
1634:                       attemptCount = length runningActs
1635: 
1636:                   case retryCtx of
1637:                     Nothing -> pure ()
1638:                     Just ctx ->
1639:                       Lucid.div_ [Lucid.class_ "metric-row"] <| do
1640:                         Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
1641:                         Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
1642: 
1643:                   when (attemptCount > 1) <| do
1644:                     Lucid.div_ [Lucid.class_ "metric-row"] <| do
1645:                       Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
1646:                       Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
1647:                     Lucid.div_ [Lucid.class_ "metric-row"] <| do
1648:                       Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
1649:                       Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
1650:                     when (totalCost > 0)
1651:                       <| Lucid.div_ [Lucid.class_ "metric-row"]
1652:                       <| do
1653:                         Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
1654:                         Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal totalCost))
1655:                     Lucid.hr_ [Lucid.class_ "attempts-divider"]
1656: 
1657:                   traverse_ (renderAttempt attemptCount) (zip [1 ..] (reverse runningActs))
1658:         where
1659:           calcDurSecs :: TaskCore.TaskActivity -> Int
1660:           calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
1661:             (Just start, Just end) -> floor (diffUTCTime end start)
1662:             _ -> 0
1663: 
1664:           formatDurSecs :: Int -> Text
1665:           formatDurSecs secs
1666:             | secs < 60 = tshow secs <> "s"
1667:             | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
1668:             | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"
1669: 
1670:           renderAttempt :: (Monad m) => Int -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
1671:           renderAttempt totalAttempts (attemptNum, act) = do
1672:             when (totalAttempts > 1)
1673:               <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
1674:             case TaskCore.activityThreadUrl act of
1675:               Nothing -> pure ()
1676:               Just url ->
1677:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
1678:                   Lucid.span_ [Lucid.class_ "metric-label"] "Session:"
1679:                   Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"
1680: 
1681:             case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
1682:               (Just start, Just end) ->
1683:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
1684:                   Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
1685:                   Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDur start end))
1686:               (Just start, Nothing) ->
1687:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
1688:                   Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
1689:                   Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now start)
1690:               _ -> pure ()
1691: 
1692:             case TaskCore.activityCostCents act of
1693:               Nothing -> pure ()
1694:               Just cents ->
1695:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
1696:                   Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
1697:                   Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal cents))
1698: 
1699:             Lucid.div_ [Lucid.class_ "metric-row"] <| do
1700:               Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
1701:               Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act))
1702: 
1703:           formatDur :: UTCTime -> UTCTime -> Text
1704:           formatDur start end =
1705:             let diffSecs = floor (diffUTCTime end start) :: Int
1706:                 mins = diffSecs `div` 60
1707:                 secs = diffSecs `mod` 60
1708:              in if mins > 0
1709:                   then tshow mins <> "m " <> tshow secs <> "s"
1710:                   else tshow secs <> "s"
1711: 
1712:           formatCostVal :: Int -> Text
1713:           formatCostVal cents =
1714:             let dollars = fromIntegral cents / 100.0 :: Double
1715:              in "$" <> Text.pack (showFFloat (Just 2) dollars "")
1716: 
1717: renderAggregatedMetrics :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> TaskCore.AggregatedMetrics -> Lucid.HtmlT m ()
1718: renderAggregatedMetrics allTasks task metrics =
1719:   let descendants = getDescendants allTasks (TaskCore.taskId task)
1720:       totalCount = length descendants
1721:       costCents = TaskCore.aggTotalCostCents metrics
1722:       durationSecs = TaskCore.aggTotalDurationSeconds metrics
1723:       completedCount = TaskCore.aggCompletedTasks metrics
1724:       tokensUsed = TaskCore.aggTotalTokens metrics
1725:    in Lucid.div_ [Lucid.class_ "detail-section aggregated-metrics"] <| do
1726:         Lucid.h3_ "Execution Summary"
1727:         Lucid.div_ [Lucid.class_ "metrics-grid"] <| do
1728:           Lucid.div_ [Lucid.class_ "metric-card"] <| do
1729:             Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow completedCount <> "/" <> tshow totalCount))
1730:             Lucid.div_ [Lucid.class_ "metric-label"] "Tasks Completed"
1731:           Lucid.div_ [Lucid.class_ "metric-card"] <| do
1732:             Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost costCents))
1733:             Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost"
1734:           Lucid.div_ [Lucid.class_ "metric-card"] <| do
1735:             Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration durationSecs))
1736:             Lucid.div_ [Lucid.class_ "metric-label"] "Total Time"
1737:           when (tokensUsed > 0) <| do
1738:             Lucid.div_ [Lucid.class_ "metric-card"] <| do
1739:               Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTokens tokensUsed))
1740:               Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used"
1741:   where
1742:     formatCost :: Int -> Text
1743:     formatCost cents =
1744:       let dollars = fromIntegral cents / 100.0 :: Double
1745:        in "$" <> Text.pack (showFFloat (Just 2) dollars "")
1746: 
1747:     formatDuration :: Int -> Text
1748:     formatDuration secs
1749:       | secs < 60 = tshow secs <> "s"
1750:       | secs < 3600 =
1751:           let mins = secs `div` 60
1752:               remSecs = secs `mod` 60
1753:            in tshow mins <> "m " <> tshow remSecs <> "s"
1754:       | otherwise =
1755:           let hrs = secs `div` 3600
1756:               mins = (secs `mod` 3600) `div` 60
1757:            in tshow hrs <> "h " <> tshow mins <> "m"
1758: 
1759:     formatTokens :: Int -> Text
1760:     formatTokens t
1761:       | t < 1000 = tshow t
1762:       | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
1763:       | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"
1764: 
1765: renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
1766: renderRetryContextBanner _ Nothing = pure ()
1767: renderRetryContextBanner tid (Just ctx) =
1768:   Lucid.div_ [Lucid.class_ bannerClass] <| do
1769:     Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do
1770:       Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon
1771:       Lucid.span_ [Lucid.class_ "retry-attempt"] (Lucid.toHtml attemptText)
1772:       when maxRetriesExceeded
1773:         <| Lucid.span_ [Lucid.class_ "retry-warning-badge"] "Needs Human Intervention"
1774: 
1775:     Lucid.div_ [Lucid.class_ "retry-banner-details"] <| do
1776:       Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
1777:         Lucid.span_ [Lucid.class_ "retry-label"] "Failure Reason:"
1778:         Lucid.span_ [Lucid.class_ "retry-value"] (Lucid.toHtml (summarizeReason (TaskCore.retryReason ctx)))
1779: 
1780:       let commit = TaskCore.retryOriginalCommit ctx
1781:       unless (Text.null commit) <| do
1782:         Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
1783:           Lucid.span_ [Lucid.class_ "retry-label"] "Original Commit:"
1784:           Lucid.code_ [Lucid.class_ "retry-commit"] (Lucid.toHtml (Text.take 8 commit))
1785: 
1786:       let conflicts = TaskCore.retryConflictFiles ctx
1787:       unless (null conflicts) <| do
1788:         Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
1789:           Lucid.span_ [Lucid.class_ "retry-label"] "Conflict Files:"
1790:           Lucid.ul_ [Lucid.class_ "retry-conflict-list"]
1791:             <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts
1792: 
1793:     when maxRetriesExceeded <| do
1794:       Lucid.div_
1795:         [Lucid.class_ "retry-warning-message"]
1796:         "This task has exceeded the maximum number of retries. A human must review the failure and either fix the issue manually or reset the retry count."
1797: 
1798:       Lucid.p_ [Lucid.class_ "retry-hint"] "Use comments below to provide guidance for retry."
1799: 
1800:       Lucid.div_ [Lucid.class_ "retry-reset-section"] <| do
1801:         Lucid.h4_ "Reset Retries"
1802:         Lucid.p_ [Lucid.class_ "notes-help"] "Clear retry context and give task a fresh start:"
1803:         Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
1804:           Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reset-btn"] "Reset Retries"
1805:   where
1806:     attempt = TaskCore.retryAttempt ctx
1807:     maxRetriesExceeded = attempt >= 3
1808:     bannerClass = if maxRetriesExceeded then "retry-banner retry-banner-critical" else "retry-banner retry-banner-warning"
1809:     retryIcon = if maxRetriesExceeded then "⚠" else "↻"
1810:     attemptText = "Attempt " <> tshow attempt <> " of 3"
1811: 
1812:     summarizeReason :: Text -> Text
1813:     summarizeReason reason
1814:       | "rejected:" `Text.isPrefixOf` reason = "Rejected: " <> Text.strip (Text.drop 9 reason)
1815:       | "Test failure:" `Text.isPrefixOf` reason = "Test failure (see details below)"
1816:       | "MERGE CONFLICT" `Text.isPrefixOf` reason = "Merge conflict with concurrent changes"
1817:       | otherwise = Text.take 100 reason <> if Text.length reason > 100 then "..." else ""
1818: 
1819: instance Lucid.ToHtml TaskReviewPage where
1820:   toHtmlRaw = Lucid.toHtml
1821:   toHtml (ReviewPageNotFound tid) =
1822:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
1823:      in Lucid.doctypehtml_ <| do
1824:           pageHead "Task Not Found - Jr Review"
1825:           pageBodyWithCrumbs crumbs <| do
1826:             Lucid.div_ [Lucid.class_ "container"] <| do
1827:               Lucid.h1_ "Task Not Found"
1828:               Lucid.p_ <| do
1829:                 "The task "
1830:                 Lucid.code_ (Lucid.toHtml tid)
1831:                 " could not be found."
1832:   toHtml (ReviewPageFound task reviewInfo) =
1833:     let tid = TaskCore.taskId task
1834:         crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
1835:      in Lucid.doctypehtml_ <| do
1836:           pageHead ("Review: " <> TaskCore.taskId task <> " - Jr")
1837:           pageBodyWithCrumbs crumbs <| do
1838:             Lucid.div_ [Lucid.class_ "container"] <| do
1839:               Lucid.h1_ "Review Task"
1840: 
1841:               Lucid.div_ [Lucid.class_ "task-summary"] <| do
1842:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1843:                   Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
1844:                   Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
1845:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1846:                   Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
1847:                   Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
1848:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1849:                   Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
1850:                   Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
1851: 
1852:               case reviewInfo of
1853:                 ReviewNoCommit ->
1854:                   Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
1855:                     Lucid.h3_ "No Commit Found"
1856:                     Lucid.p_ "No commit with this task ID was found in the git history."
1857:                     Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
1858:                 ReviewMergeConflict commitSha conflictFiles ->
1859:                   Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
1860:                     Lucid.h3_ "Merge Conflict Detected"
1861:                     Lucid.p_ <| do
1862:                       "Commit "
1863:                       Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
1864:                       " cannot be cleanly merged."
1865:                     Lucid.p_ "Conflicting files:"
1866:                     Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
1867:                 ReviewReady commitSha diffText -> do
1868:                   Lucid.div_ [Lucid.class_ "diff-section"] <| do
1869:                     Lucid.h3_ <| do
1870:                       "Commit: "
1871:                       Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
1872:                     Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)
1873: 
1874:                   Lucid.div_ [Lucid.class_ "review-actions"] <| do
1875:                     Lucid.form_
1876:                       [ Lucid.method_ "POST",
1877:                         Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
1878:                         Lucid.class_ "inline-form"
1879:                       ]
1880:                       <| do
1881:                         Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"
1882: 
1883:                     Lucid.form_
1884:                       [ Lucid.method_ "POST",
1885:                         Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
1886:                         Lucid.class_ "reject-form"
1887:                       ]
1888:                       <| do
1889:                         Lucid.textarea_
1890:                           [ Lucid.name_ "notes",
1891:                             Lucid.class_ "reject-notes",
1892:                             Lucid.placeholder_ "Rejection notes (optional)"
1893:                           ]
1894:                           ""
1895:                         Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject"
1896: 
1897: instance Lucid.ToHtml TaskDiffPage where
1898:   toHtmlRaw = Lucid.toHtml
1899:   toHtml (DiffPageNotFound tid commitHash') =
1900:     let shortHash = Text.take 8 commitHash'
1901:         crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
1902:      in Lucid.doctypehtml_ <| do
1903:           pageHead "Commit Not Found - Jr"
1904:           pageBodyWithCrumbs crumbs <| do
1905:             Lucid.div_ [Lucid.class_ "container"] <| do
1906:               Lucid.h1_ "Commit Not Found"
1907:               Lucid.p_ <| do
1908:                 "Could not find commit "
1909:                 Lucid.code_ (Lucid.toHtml commitHash')
1910:               Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
1911:   toHtml (DiffPageFound tid commitHash' diffOutput) =
1912:     let shortHash = Text.take 8 commitHash'
1913:         crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
1914:      in Lucid.doctypehtml_ <| do
1915:           pageHead ("Diff " <> shortHash <> " - Jr")
1916:           pageBodyWithCrumbs crumbs <| do
1917:             Lucid.div_ [Lucid.class_ "container"] <| do
1918:               Lucid.div_ [Lucid.class_ "diff-header"] <| do
1919:                 Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
1920:                 Lucid.h1_ <| do
1921:                   "Commit "
1922:                   Lucid.code_ (Lucid.toHtml shortHash)
1923:               Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput)
1924: 
1925: instance Lucid.ToHtml StatsPage where
1926:   toHtmlRaw = Lucid.toHtml
1927:   toHtml (StatsPage stats maybeEpic) =
1928:     let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Stats" Nothing]
1929:      in Lucid.doctypehtml_ <| do
1930:           pageHead "Task Statistics - Jr"
1931:           pageBodyWithCrumbs crumbs <| do
1932:             Lucid.div_ [Lucid.class_ "container"] <| do
1933:               Lucid.h1_ <| case maybeEpic of
1934:                 Nothing -> "Task Statistics"
1935:                 Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId)
1936: 
1937:               Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do
1938:                 Lucid.div_ [Lucid.class_ "filter-row"] <| do
1939:                   Lucid.div_ [Lucid.class_ "filter-group"] <| do
1940:                     Lucid.label_ [Lucid.for_ "epic"] "Epic:"
1941:                     Lucid.input_
1942:                       [ Lucid.type_ "text",
1943:                         Lucid.name_ "epic",
1944:                         Lucid.id_ "epic",
1945:                         Lucid.class_ "filter-input",
1946:                         Lucid.placeholder_ "Epic ID (optional)",
1947:                         Lucid.value_ (fromMaybe "" maybeEpic)
1948:                       ]
1949:                   Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
1950:                   Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear"
1951: 
1952:               Lucid.h2_ "By Status"
1953:               multiColorProgressBar stats
1954:               Lucid.div_ [Lucid.class_ "stats-grid"] <| do
1955:                 statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats)
1956:                 statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats)
1957:                 statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats)
1958:                 statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats)
1959:                 statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats)
1960: 
1961:               Lucid.h2_ "By Priority"
1962:               Lucid.div_ [Lucid.class_ "stats-section"] <| do
1963:                 traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats)
1964: 
1965:               Lucid.h2_ "By Namespace"
1966:               Lucid.div_ [Lucid.class_ "stats-section"] <| do
1967:                 if null (TaskCore.tasksByNamespace stats)
1968:                   then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found."
1969:                   else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats)
1970: 
1971:               Lucid.h2_ "Summary"
1972:               Lucid.div_ [Lucid.class_ "summary-section"] <| do
1973:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1974:                   Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:"
1975:                   Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats)))
1976:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1977:                   Lucid.span_ [Lucid.class_ "detail-label"] "Epics:"
1978:                   Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats)))
1979:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1980:                   Lucid.span_ [Lucid.class_ "detail-label"] "Ready:"
1981:                   Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats)))
1982:                 Lucid.div_ [Lucid.class_ "detail-row"] <| do
1983:                   Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:"
1984:                   Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats)))
1985:     where
1986:       statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m ()
1987:       statCard label count total =
1988:         let pct = if total == 0 then 0 else (count * 100) `div` total
1989:          in Lucid.div_ [Lucid.class_ "stat-card"] <| do
1990:               Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
1991:               Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
1992:               Lucid.div_ [Lucid.class_ "progress-bar"] <| do
1993:                 Lucid.div_
1994:                   [ Lucid.class_ "progress-fill",
1995:                     Lucid.style_ ("width: " <> tshow pct <> "%")
1996:                   ]
1997:                   ""
1998: 
1999:       renderPriorityRow :: (Monad m) => TaskCore.Priority -> Int -> Lucid.HtmlT m ()
2000:       renderPriorityRow priority count =
2001:         let total = TaskCore.totalTasks stats
2002:             pct = if total == 0 then 0 else (count * 100) `div` total
2003:          in Lucid.div_ [Lucid.class_ "stats-row"] <| do
2004:               Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml (tshow priority))
2005:               Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
2006:                 Lucid.div_ [Lucid.class_ "progress-bar"] <| do
2007:                   Lucid.div_
2008:                     [ Lucid.class_ "progress-fill",
2009:                       Lucid.style_ ("width: " <> tshow pct <> "%")
2010:                     ]
2011:                     ""
2012:               Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))
2013: 
2014:       renderNamespaceRow :: (Monad m) => Int -> Text -> Int -> Lucid.HtmlT m ()
2015:       renderNamespaceRow total ns count =
2016:         let pct = if total == 0 then 0 else (count * 100) `div` total
2017:          in Lucid.div_ [Lucid.class_ "stats-row"] <| do
2018:               Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml ns)
2019:               Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
2020:                 Lucid.div_ [Lucid.class_ "progress-bar"] <| do
2021:                   Lucid.div_
2022:                     [ Lucid.class_ "progress-fill",
2023:                       Lucid.style_ ("width: " <> tshow pct <> "%")
2024:                     ]
2025:                     ""
2026:               Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))
2027: 
2028: instance Lucid.ToHtml RecentActivityNewPartial where
2029:   toHtmlRaw = Lucid.toHtml
2030:   toHtml (RecentActivityNewPartial tasks maybeNewestTs) = do
2031:     traverse_ renderListGroupItem tasks
2032:     case maybeNewestTs of
2033:       Nothing -> pure ()
2034:       Just ts ->
2035:         Lucid.div_
2036:           [ Lucid.id_ "recent-activity",
2037:             Lucid.makeAttribute "data-newest-ts" (tshow ts),
2038:             Lucid.makeAttribute "hx-swap-oob" "attributes:#recent-activity data-newest-ts"
2039:           ]
2040:           ""
2041: 
2042: instance Lucid.ToHtml RecentActivityMorePartial where
2043:   toHtmlRaw = Lucid.toHtml
2044:   toHtml (RecentActivityMorePartial tasks nextOffset hasMore) = do
2045:     traverse_ renderListGroupItem tasks
2046:     if hasMore
2047:       then
2048:         Lucid.button_
2049:           [ Lucid.id_ "activity-load-more",
2050:             Lucid.class_ "btn btn-secondary load-more-btn",
2051:             Lucid.makeAttribute "hx-get" ("/partials/recent-activity-more?offset=" <> tshow nextOffset),
2052:             Lucid.makeAttribute "hx-target" "#activity-list",
2053:             Lucid.makeAttribute "hx-swap" "beforeend",
2054:             Lucid.makeAttribute "hx-swap-oob" "true"
2055:           ]
2056:           "Load More"
2057:       else Lucid.span_ [Lucid.id_ "activity-load-more", Lucid.makeAttribute "hx-swap-oob" "true"] ""
2058: 
2059: instance Lucid.ToHtml ReadyCountPartial where
2060:   toHtmlRaw = Lucid.toHtml
2061:   toHtml (ReadyCountPartial count) =
2062:     Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
2063:       <| Lucid.toHtml ("(" <> tshow count <> " tasks)")
2064: 
2065: instance Lucid.ToHtml StatusBadgePartial where
2066:   toHtmlRaw = Lucid.toHtml
2067:   toHtml (StatusBadgePartial status tid) =
2068:     statusBadgeWithForm status tid
2069: 
2070: instance Lucid.ToHtml PriorityBadgePartial where
2071:   toHtmlRaw = Lucid.toHtml
2072:   toHtml (PriorityBadgePartial priority tid) =
2073:     priorityBadgeWithForm priority tid
2074: 
2075: instance Lucid.ToHtml TaskListPartial where
2076:   toHtmlRaw = Lucid.toHtml
2077:   toHtml (TaskListPartial tasks) =
2078:     if null tasks
2079:       then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
2080:       else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
2081: 
2082: instance Lucid.ToHtml TaskMetricsPartial where
2083:   toHtmlRaw = Lucid.toHtml
2084:   toHtml (TaskMetricsPartial _tid activities maybeRetry now) =
2085:     let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities
2086:      in if null runningActs
2087:           then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
2088:           else
2089:             Lucid.div_ [Lucid.class_ "execution-details"] <| do
2090:               let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
2091:                   totalDuration = sum [calcDurSecs act | act <- runningActs]
2092:                   attemptCount = length runningActs
2093: 
2094:               case maybeRetry of
2095:                 Nothing -> pure ()
2096:                 Just ctx ->
2097:                   Lucid.div_ [Lucid.class_ "metric-row"] <| do
2098:                     Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
2099:                     Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))
2100: 
2101:               when (attemptCount > 1) <| do
2102:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
2103:                   Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
2104:                   Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
2105:                 Lucid.div_ [Lucid.class_ "metric-row"] <| do
2106:                   Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
2107:                   Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
2108:                 when (totalCost > 0)
2109:                   <| Lucid.div_ [Lucid.class_ "metric-row"]
2110:                   <| do
2111:                     Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
2112:                     Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost totalCost))
2113:                 Lucid.hr_ [Lucid.class_ "attempts-divider"]
2114: 
2115:               traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs))
2116:     where
2117:       calcDurSecs :: TaskCore.TaskActivity -> Int
2118:       calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
2119:         (Just start, Just end) -> floor (diffUTCTime end start)
2120:         _ -> 0
2121: 
2122:       formatDurSecs :: Int -> Text
2123:       formatDurSecs secs
2124:         | secs < 60 = tshow secs <> "s"
2125:         | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
2126:         | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"
2127: 
2128:       renderAttempt :: (Monad m) => Int -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
2129:       renderAttempt totalAttempts currentTime (attemptNum, act) = do
2130:         when (totalAttempts > 1)
2131:           <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
2132:         case TaskCore.activityThreadUrl act of
2133:           Nothing -> pure ()
2134:           Just url ->
2135:             Lucid.div_ [Lucid.class_ "metric-row"] <| do
2136:               Lucid.span_ [Lucid.class_ "metric-label"] "Session:"
2137:               Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"
2138: 
2139:         case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
2140:           (Just start, Just end) ->
2141:             Lucid.div_ [Lucid.class_ "metric-row"] <| do
2142:               Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
2143:               Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration start end))
2144:           (Just start, Nothing) ->
2145:             Lucid.div_ [Lucid.class_ "metric-row"] <| do
2146:               Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
2147:               Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime start)
2148:           _ -> pure ()
2149: 
2150:         case TaskCore.activityCostCents act of
2151:           Nothing -> pure ()
2152:           Just cents ->
2153:             Lucid.div_ [Lucid.class_ "metric-row"] <| do
2154:               Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
2155:               Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost cents))
2156: 
2157:         Lucid.div_ [Lucid.class_ "metric-row"] <| do
2158:           Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
2159:           Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act))
2160: 
2161:       formatDuration :: UTCTime -> UTCTime -> Text
2162:       formatDuration start end =
2163:         let diffSecs = floor (diffUTCTime end start) :: Int
2164:             mins = diffSecs `div` 60
2165:             secs = diffSecs `mod` 60
2166:          in if mins > 0
2167:               then tshow mins <> "m " <> tshow secs <> "s"
2168:               else tshow secs <> "s"
2169: 
2170:       formatCost :: Int -> Text
2171:       formatCost cents =
2172:         let dollars = fromIntegral cents / 100.0 :: Double
2173:          in "$" <> Text.pack (showFFloat (Just 2) dollars "")
2174: 
2175: instance Lucid.ToHtml DescriptionViewPartial where
2176:   toHtmlRaw = Lucid.toHtml
2177:   toHtml (DescriptionViewPartial tid desc isEpic) =
2178:     Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block"] <| do
2179:       Lucid.div_ [Lucid.class_ "description-header"] <| do
2180:         Lucid.h3_ (if isEpic then "Design" else "Description")
2181:         Lucid.a_
2182:           [ Lucid.href_ "#",
2183:             Lucid.class_ "edit-link",
2184:             Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"),
2185:             Lucid.makeAttribute "hx-target" "#description-block",
2186:             Lucid.makeAttribute "hx-swap" "outerHTML"
2187:           ]
2188:           "Edit"
2189:       if Text.null desc
2190:         then Lucid.p_ [Lucid.class_ "empty-msg"] (if isEpic then "No design document yet." else "No description yet.")
2191:         else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
2192: 
2193: instance Lucid.ToHtml DescriptionEditPartial where
2194:   toHtmlRaw = Lucid.toHtml
2195:   toHtml (DescriptionEditPartial tid desc isEpic) =
2196:     Lucid.div_ [Lucid.id_ "description-block", Lucid.class_ "description-block editing"] <| do
2197:       Lucid.div_ [Lucid.class_ "description-header"] <| do
2198:         Lucid.h3_ (if isEpic then "Design" else "Description")
2199:         Lucid.button_
2200:           [ Lucid.type_ "button",
2201:             Lucid.class_ "cancel-link",
2202:             Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"),
2203:             Lucid.makeAttribute "hx-target" "#description-block",
2204:             Lucid.makeAttribute "hx-swap" "outerHTML",
2205:             Lucid.makeAttribute "hx-confirm" "Discard changes?"
2206:           ]
2207:           "Cancel"
2208:       Lucid.form_
2209:         [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"),
2210:           Lucid.makeAttribute "hx-target" "#description-block",
2211:           Lucid.makeAttribute "hx-swap" "outerHTML"
2212:         ]
2213:         <| do
2214:           Lucid.textarea_
2215:             [ Lucid.name_ "description",
2216:               Lucid.class_ "description-textarea",
2217:               Lucid.rows_ (if isEpic then "15" else "10"),
2218:               Lucid.placeholder_ (if isEpic then "Enter design in Markdown..." else "Enter description...")
2219:             ]
2220:             (Lucid.toHtml desc)
2221:           Lucid.div_ [Lucid.class_ "form-actions"] <| do
2222:             Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save"
2223: 
2224: -- | Simple markdown renderer for epic descriptions
2225: -- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
2226: renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
2227: renderMarkdown input = renderBlocks (parseBlocks (Text.lines input))
2228: 
2229: data MarkdownBlock
2230:   = MdHeader Int Text
2231:   | MdParagraph [Text]
2232:   | MdCodeBlock [Text]
2233:   | MdList [Text]
2234:   deriving (Show, Eq)
2235: 
2236: parseBlocks :: [Text] -> [MarkdownBlock]
2237: parseBlocks [] = []
2238: parseBlocks lns = case lns of
2239:   (l : rest)
2240:     | "```" `Text.isPrefixOf` l ->
2241:         let (codeLines, afterCode) = List.span (not <. Text.isPrefixOf "```") rest
2242:             remaining = List.drop 1 afterCode
2243:          in MdCodeBlock codeLines : parseBlocks remaining
2244:     | "### " `Text.isPrefixOf` l ->
2245:         MdHeader 3 (Text.drop 4 l) : parseBlocks rest
2246:     | "## " `Text.isPrefixOf` l ->
2247:         MdHeader 2 (Text.drop 3 l) : parseBlocks rest
2248:     | "# " `Text.isPrefixOf` l ->
2249:         MdHeader 1 (Text.drop 2 l) : parseBlocks rest
2250:     | isListItem l ->
2251:         let (listLines, afterList) = List.span isListItem lns
2252:          in MdList (map stripListPrefix listLines) : parseBlocks afterList
2253:     | Text.null (Text.strip l) ->
2254:         parseBlocks rest
2255:     | otherwise ->
2256:         let (paraLines, afterPara) = List.span isParagraphLine lns
2257:          in MdParagraph paraLines : parseBlocks afterPara
2258:   where
2259:     isListItem t =
2260:       let stripped = Text.stripStart t
2261:        in "- " `Text.isPrefixOf` stripped || "* " `Text.isPrefixOf` stripped
2262:     stripListPrefix t =
2263:       let stripped = Text.stripStart t
2264:        in Text.drop 2 stripped
2265:     isParagraphLine t =
2266:       not (Text.null (Text.strip t))
2267:         && not ("```" `Text.isPrefixOf` t)
2268:         && not ("#" `Text.isPrefixOf` t)
2269:         && not (isListItem t)
2270: 
2271: renderBlocks :: (Monad m) => [MarkdownBlock] -> Lucid.HtmlT m ()
2272: renderBlocks = traverse_ renderBlock
2273: 
2274: renderBlock :: (Monad m) => MarkdownBlock -> Lucid.HtmlT m ()
2275: renderBlock block = case block of
2276:   MdHeader 1 txt -> Lucid.h2_ [Lucid.class_ "md-h1"] (renderInline txt)
2277:   MdHeader 2 txt -> Lucid.h3_ [Lucid.class_ "md-h2"] (renderInline txt)
2278:   MdHeader 3 txt -> Lucid.h4_ [Lucid.class_ "md-h3"] (renderInline txt)
2279:   MdHeader _ txt -> Lucid.h4_ (renderInline txt)
2280:   MdParagraph lns -> Lucid.p_ [Lucid.class_ "md-para"] (renderInline (Text.unlines lns))
2281:   MdCodeBlock lns -> Lucid.pre_ [Lucid.class_ "md-code"] (Lucid.code_ (Lucid.toHtml (Text.unlines lns)))
2282:   MdList items -> Lucid.ul_ [Lucid.class_ "md-list"] (traverse_ renderListItem items)
2283: 
2284: renderListItem :: (Monad m) => Text -> Lucid.HtmlT m ()
2285: renderListItem txt = Lucid.li_ (renderInline txt)
2286: 
2287: -- | Render inline markdown (backtick code, bold, italic)
2288: renderInline :: (Monad m) => Text -> Lucid.HtmlT m ()
2289: renderInline txt = renderInlineParts (parseInline txt)
2290: 
2291: data InlinePart = PlainText Text | InlineCode Text | BoldText Text
2292:   deriving (Show, Eq)
2293: 
2294: parseInline :: Text -> [InlinePart]
2295: parseInline t
2296:   | Text.null t = []
2297:   | otherwise = case Text.breakOn "`" t of
2298:       (before, rest)
2299:         | Text.null rest -> parseBold before
2300:         | otherwise ->
2301:             let afterTick = Text.drop 1 rest
2302:              in case Text.breakOn "`" afterTick of
2303:                   (code, rest2)
2304:                     | Text.null rest2 ->
2305:                         parseBold before ++ [PlainText ("`" <> afterTick)]
2306:                     | otherwise ->
2307:                         parseBold before ++ [InlineCode code] ++ parseInline (Text.drop 1 rest2)
2308: 
2309: parseBold :: Text -> [InlinePart]
2310: parseBold t
2311:   | Text.null t = []
2312:   | otherwise = case Text.breakOn "**" t of
2313:       (before, rest)
2314:         | Text.null rest -> [PlainText before | not (Text.null before)]
2315:         | otherwise ->
2316:             let afterBold = Text.drop 2 rest
2317:              in case Text.breakOn "**" afterBold of
2318:                   (boldText, rest2)
2319:                     | Text.null rest2 ->
2320:                         [PlainText before | not (Text.null before)] ++ [PlainText ("**" <> afterBold)]
2321:                     | otherwise ->
2322:                         [PlainText before | not (Text.null before)]
2323:                           ++ [BoldText boldText]
2324:                           ++ parseBold (Text.drop 2 rest2)
2325: 
2326: renderInlineParts :: (Monad m) => [InlinePart] -> Lucid.HtmlT m ()
2327: renderInlineParts = traverse_ renderInlinePart
2328: 
2329: renderInlinePart :: (Monad m) => InlinePart -> Lucid.HtmlT m ()
2330: renderInlinePart part = case part of
2331:   PlainText txt -> Lucid.toHtml txt
2332:   InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt)
2333:   BoldText txt -> Lucid.strong_ (Lucid.toHtml txt)
2334: 
2335: -- | Comment form for adding new comments
2336: commentForm :: (Monad m) => Text -> Lucid.HtmlT m ()
2337: commentForm tid =
2338:   Lucid.form_
2339:     [ Lucid.method_ "POST",
2340:       Lucid.action_ ("/tasks/" <> tid <> "/comment"),
2341:       Lucid.class_ "comment-form"
2342:     ]
2343:     <| do
2344:       Lucid.textarea_
2345:         [ Lucid.name_ "comment",
2346:           Lucid.placeholder_ "Add a comment...",
2347:           Lucid.rows_ "3",
2348:           Lucid.class_ "comment-textarea"
2349:         ]
2350:         ""
2351:       Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Post Comment"
2352: 
2353: -- | Unified timeline view combining comments, status changes, and agent events
2354: renderUnifiedTimeline :: (Monad m) => Text -> [TaskCore.Comment] -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
2355: renderUnifiedTimeline tid legacyComments events status now = do
2356:   let isInProgress = status == TaskCore.InProgress
2357:       pollAttrs =
2358:         if isInProgress
2359:           then
2360:             [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> tid <> "/events"),
2361:               Lucid.makeAttribute "hx-trigger" "every 3s",
2362:               Lucid.makeAttribute "hx-swap" "innerHTML",
2363:               Lucid.makeAttribute "hx-on::before-request" "var log = this.querySelector('.timeline-events'); if(log) this.dataset.scroll = log.scrollTop",
2364:               Lucid.makeAttribute "hx-on::after-swap" "var log = this.querySelector('.timeline-events'); if(log && this.dataset.scroll) log.scrollTop = this.dataset.scroll"
2365:             ]
2366:           else []
2367:   Lucid.div_ ([Lucid.class_ "unified-timeline-section", Lucid.id_ "unified-timeline"] <> pollAttrs) <| do
2368:     Lucid.h3_ <| do
2369:       Lucid.toHtml ("Timeline (" <> tshow (length events + length legacyComments) <> ")")
2370:       when isInProgress <| Lucid.span_ [Lucid.class_ "timeline-live"] " LIVE"
2371: 
2372:     if null events && null legacyComments
2373:       then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
2374:       else do
2375:         Lucid.div_ [Lucid.class_ "timeline-events"] <| do
2376:           traverse_ (renderTimelineEvent now) events
2377:         when isInProgress <| timelineScrollScript
2378: 
2379:     commentForm tid
2380: 
2381: -- | Render a single timeline event with icon, actor label, and timestamp
2382: renderTimelineEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
2383: renderTimelineEvent now event =
2384:   let eventType = TaskCore.storedEventType event
2385:       content = TaskCore.storedEventContent event
2386:       timestamp = TaskCore.storedEventTimestamp event
2387:       actor = TaskCore.storedEventActor event
2388:       eventId = TaskCore.storedEventId event
2389:       (icon, label) = eventTypeIconAndLabel eventType
2390:    in Lucid.div_
2391:         [ Lucid.class_ ("timeline-event timeline-event-" <> eventType),
2392:           Lucid.makeAttribute "data-event-id" (tshow eventId)
2393:         ]
2394:         <| do
2395:           case eventType of
2396:             "comment" -> renderCommentTimelineEvent content actor timestamp now
2397:             "status_change" -> renderStatusChangeEvent content actor timestamp now
2398:             "claim" -> renderActivityEvent icon label content actor timestamp now
2399:             "running" -> renderActivityEvent icon label content actor timestamp now
2400:             "reviewing" -> renderActivityEvent icon label content actor timestamp now
2401:             "retrying" -> renderActivityEvent icon label content actor timestamp now
2402:             "complete" -> renderActivityEvent icon label content actor timestamp now
2403:             "error" -> renderErrorTimelineEvent content actor timestamp now
2404:             "Assistant" -> renderAssistantTimelineEvent content actor timestamp now
2405:             "ToolCall" -> renderToolCallTimelineEvent content actor timestamp now
2406:             "ToolResult" -> renderToolResultTimelineEvent content actor timestamp now
2407:             "Cost" -> renderCostTimelineEvent content
2408:             "Checkpoint" -> renderCheckpointEvent content actor timestamp now
2409:             "Guardrail" -> renderGuardrailEvent content actor timestamp now
2410:             _ -> renderGenericEvent eventType content actor timestamp now
2411: 
2412: -- | Get icon and label for event type
2413: eventTypeIconAndLabel :: Text -> (Text, Text)
2414: eventTypeIconAndLabel "comment" = ("💬", "Comment")
2415: eventTypeIconAndLabel "status_change" = ("🔄", "Status")
2416: eventTypeIconAndLabel "claim" = ("🤖", "Claimed")
2417: eventTypeIconAndLabel "running" = ("▶️", "Running")
2418: eventTypeIconAndLabel "reviewing" = ("👀", "Reviewing")
2419: eventTypeIconAndLabel "retrying" = ("🔁", "Retrying")
2420: eventTypeIconAndLabel "complete" = ("✅", "Complete")
2421: eventTypeIconAndLabel "error" = ("❌", "Error")
2422: eventTypeIconAndLabel "Assistant" = ("💭", "Thought")
2423: eventTypeIconAndLabel "ToolCall" = ("🔧", "Tool")
2424: eventTypeIconAndLabel "ToolResult" = ("📄", "Result")
2425: eventTypeIconAndLabel "Cost" = ("💰", "Cost")
2426: eventTypeIconAndLabel "Checkpoint" = ("📍", "Checkpoint")
2427: eventTypeIconAndLabel "Guardrail" = ("⚠️", "Guardrail")
2428: eventTypeIconAndLabel t = ("📝", t)
2429: 
2430: -- | Render actor label
2431: renderActorLabel :: (Monad m) => TaskCore.CommentAuthor -> Lucid.HtmlT m ()
2432: renderActorLabel actor =
2433:   let (cls, label) :: (Text, Text) = case actor of
2434:         TaskCore.Human -> ("actor-human", "human")
2435:         TaskCore.Junior -> ("actor-junior", "junior")
2436:         TaskCore.System -> ("actor-system", "system")
2437:    in Lucid.span_ [Lucid.class_ ("actor-label " <> cls)] (Lucid.toHtml ("[" <> label <> "]"))
2438: 
2439: -- | Render comment event
2440: renderCommentTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2441: renderCommentTimelineEvent content actor timestamp now =
2442:   Lucid.div_ [Lucid.class_ "timeline-comment"] <| do
2443:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2444:       Lucid.span_ [Lucid.class_ "event-icon"] "💬"
2445:       renderActorLabel actor
2446:       renderRelativeTimestamp now timestamp
2447:     Lucid.div_ [Lucid.class_ "event-content comment-bubble markdown-content"] <| do
2448:       renderMarkdown content
2449: 
2450: -- | Render status change event
2451: renderStatusChangeEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2452: renderStatusChangeEvent content actor timestamp now =
2453:   Lucid.div_ [Lucid.class_ "timeline-status-change"] <| do
2454:     Lucid.span_ [Lucid.class_ "event-icon"] "🔄"
2455:     renderActorLabel actor
2456:     Lucid.span_ [Lucid.class_ "status-change-text"] (Lucid.toHtml (parseStatusChange content))
2457:     renderRelativeTimestamp now timestamp
2458: 
2459: -- | Parse status change JSON
2460: parseStatusChange :: Text -> Text
2461: parseStatusChange content =
2462:   case Aeson.decode (LBS.fromStrict (str content)) of
2463:     Just (Aeson.Object obj) ->
2464:       let fromStatus = case KeyMap.lookup "from" obj of
2465:             Just (Aeson.String s) -> s
2466:             _ -> "?"
2467:           toStatus = case KeyMap.lookup "to" obj of
2468:             Just (Aeson.String s) -> s
2469:             _ -> "?"
2470:        in fromStatus <> " → " <> toStatus
2471:     _ -> content
2472: 
2473: -- | Render activity event (claim, running, etc.)
2474: renderActivityEvent :: (Monad m) => Text -> Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2475: renderActivityEvent icon label content actor timestamp now =
2476:   Lucid.div_ [Lucid.class_ "timeline-activity"] <| do
2477:     Lucid.span_ [Lucid.class_ "event-icon"] (Lucid.toHtml icon)
2478:     Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml label)
2479:     renderActorLabel actor
2480:     unless (Text.null content) <| Lucid.span_ [Lucid.class_ "activity-detail"] (Lucid.toHtml content)
2481:     renderRelativeTimestamp now timestamp
2482: 
2483: -- | Render error event
2484: renderErrorTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2485: renderErrorTimelineEvent content actor timestamp now =
2486:   Lucid.div_ [Lucid.class_ "timeline-error"] <| do
2487:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2488:       Lucid.span_ [Lucid.class_ "event-icon"] "❌"
2489:       Lucid.span_ [Lucid.class_ "event-label"] "Error"
2490:       renderActorLabel actor
2491:       renderRelativeTimestamp now timestamp
2492:     Lucid.div_ [Lucid.class_ "event-content error-message"] (Lucid.toHtml content)
2493: 
2494: -- | Render assistant thought event
2495: renderAssistantTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2496: renderAssistantTimelineEvent content _actor timestamp now =
2497:   Lucid.div_ [Lucid.class_ "timeline-thought"] <| do
2498:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2499:       Lucid.span_ [Lucid.class_ "event-icon"] "💭"
2500:       Lucid.span_ [Lucid.class_ "event-label"] "Thought"
2501:       renderActorLabel TaskCore.Junior
2502:       renderRelativeTimestamp now timestamp
2503:     Lucid.div_ [Lucid.class_ "event-content thought-bubble markdown-content"] <| do
2504:       let truncated = Text.take 2000 content
2505:           isTruncated = Text.length content > 2000
2506:       renderMarkdown truncated
2507:       when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
2508: 
2509: -- | Render tool call event
2510: renderToolCallTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2511: renderToolCallTimelineEvent content _actor timestamp now =
2512:   let (toolName, args) = parseToolCallContent content
2513:    in Lucid.details_ [Lucid.class_ "timeline-tool-call"] <| do
2514:         Lucid.summary_ <| do
2515:           Lucid.span_ [Lucid.class_ "event-icon"] "🔧"
2516:           Lucid.span_ [Lucid.class_ "tool-name"] (Lucid.toHtml toolName)
2517:           renderActorLabel TaskCore.Junior
2518:           renderRelativeTimestamp now timestamp
2519:         Lucid.div_ [Lucid.class_ "event-content tool-args"] <| do
2520:           renderCollapsibleOutput args
2521: 
2522: -- | Render tool result event (collapsed by default)
2523: renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2524: renderToolResultTimelineEvent content _actor timestamp now =
2525:   let lineCount = length (Text.lines content)
2526:    in Lucid.details_ [Lucid.class_ "timeline-tool-result"] <| do
2527:         Lucid.summary_ <| do
2528:           Lucid.span_ [Lucid.class_ "event-icon"] "📄"
2529:           Lucid.span_ [Lucid.class_ "event-label"] "Result"
2530:           when (lineCount > 1)
2531:             <| Lucid.span_ [Lucid.class_ "line-count"] (Lucid.toHtml (tshow lineCount <> " lines"))
2532:           renderRelativeTimestamp now timestamp
2533:         Lucid.pre_ [Lucid.class_ "event-content tool-output"] (renderDecodedToolResult content)
2534: 
2535: -- | Render cost event (inline)
2536: renderCostTimelineEvent :: (Monad m) => Text -> Lucid.HtmlT m ()
2537: renderCostTimelineEvent content =
2538:   Lucid.div_ [Lucid.class_ "timeline-cost"] <| do
2539:     Lucid.span_ [Lucid.class_ "event-icon"] "💰"
2540:     Lucid.span_ [Lucid.class_ "cost-text"] (Lucid.toHtml content)
2541: 
2542: -- | Render checkpoint event
2543: renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2544: renderCheckpointEvent content actor timestamp now =
2545:   Lucid.div_ [Lucid.class_ "timeline-checkpoint"] <| do
2546:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2547:       Lucid.span_ [Lucid.class_ "event-icon"] "📍"
2548:       Lucid.span_ [Lucid.class_ "event-label"] "Checkpoint"
2549:       renderActorLabel actor
2550:       renderRelativeTimestamp now timestamp
2551:     Lucid.div_ [Lucid.class_ "event-content checkpoint-content"] (Lucid.toHtml content)
2552: 
2553: -- | Render guardrail event
2554: renderGuardrailEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2555: renderGuardrailEvent content actor timestamp now =
2556:   Lucid.div_ [Lucid.class_ "timeline-guardrail"] <| do
2557:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2558:       Lucid.span_ [Lucid.class_ "event-icon"] "⚠️"
2559:       Lucid.span_ [Lucid.class_ "event-label"] "Guardrail"
2560:       renderActorLabel actor
2561:       renderRelativeTimestamp now timestamp
2562:     Lucid.div_ [Lucid.class_ "event-content guardrail-content"] (Lucid.toHtml content)
2563: 
2564: -- | Render generic/unknown event
2565: renderGenericEvent :: (Monad m) => Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2566: renderGenericEvent eventType content actor timestamp now =
2567:   Lucid.div_ [Lucid.class_ "timeline-generic"] <| do
2568:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2569:       Lucid.span_ [Lucid.class_ "event-icon"] "📝"
2570:       Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml eventType)
2571:       renderActorLabel actor
2572:       renderRelativeTimestamp now timestamp
2573:     unless (Text.null content) <| Lucid.div_ [Lucid.class_ "event-content"] (Lucid.toHtml content)
2574: 
2575: parseToolCallContent :: Text -> (Text, Text)
2576: parseToolCallContent content =
2577:   case Text.breakOn ":" content of
2578:     (name, rest)
2579:       | Text.null rest -> (content, "")
2580:       | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))
2581: 
2582: renderCollapsibleOutput :: (Monad m) => Text -> Lucid.HtmlT m ()
2583: renderCollapsibleOutput content =
2584:   let lineCount = length (Text.lines content)
2585:    in if lineCount > 20
2586:         then
2587:           Lucid.details_ [Lucid.class_ "output-collapsible"] <| do
2588:             Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
2589:             Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
2590:         else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
2591: 
2592: -- | Decode JSON tool result and render in a user-friendly way
2593: renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
2594: renderDecodedToolResult content =
2595:   case Aeson.decode (LBS.fromStrict (str content)) of
2596:     Just (Aeson.Object obj) ->
2597:       case KeyMap.lookup "output" obj of
2598:         Just (Aeson.String output) -> Lucid.toHtml output
2599:         _ -> Lucid.toHtml content -- Fallback to raw if no output field
2600:     _ -> Lucid.toHtml content -- Fallback to raw if not JSON
2601: 
2602: timelineScrollScript :: (Monad m) => Lucid.HtmlT m ()
2603: timelineScrollScript =
2604:   Lucid.script_
2605:     [ Lucid.type_ "text/javascript"
2606:     ]
2607:     ( Text.unlines
2608:         [ "(function() {",
2609:           "  var log = document.querySelector('.timeline-events');",
2610:           "  if (log) {",
2611:           "    var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",
2612:           "    if (isNearBottom) {",
2613:           "      log.scrollTop = log.scrollHeight;",
2614:           "    }",
2615:           "  }",
2616:           "})();"
2617:         ]
2618:     )
2619: 
2620: instance Lucid.ToHtml AgentEventsPartial where
2621:   toHtmlRaw = Lucid.toHtml
2622:   toHtml (AgentEventsPartial events isInProgress now) = do
2623:     Lucid.h3_ <| do
2624:       Lucid.toHtml ("Timeline (" <> tshow (length events) <> ")")
2625:       when isInProgress <| Lucid.span_ [Lucid.class_ "timeline-live"] " LIVE"
2626:     if null events
2627:       then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
2628:       else do
2629:         Lucid.div_ [Lucid.class_ "timeline-events"] <| do
2630:           traverse_ (renderTimelineEvent now) events
2631:         timelineScrollScript
2632: 
2633: -- | Stream agent events as SSE
2634: streamAgentEvents :: Text -> Text -> IO (SourceIO ByteString)
2635: streamAgentEvents tid sid = do
2636:   -- Get existing events first
2637:   existingEvents <- TaskCore.getEventsForSession sid
2638:   let lastId = if null existingEvents then 0 else maximum (map TaskCore.storedEventId existingEvents)
2639: 
2640:   -- Convert existing events to SSE format
2641:   let existingSSE = map eventToSSE existingEvents
2642: 
2643:   -- Create a streaming source that sends existing events, then polls for new ones
2644:   pure <| Source.fromStepT <| streamEventsStep tid sid lastId existingSSE True
2645: 
2646: -- | Step function for streaming events
2647: streamEventsStep :: Text -> Text -> Int -> [ByteString] -> Bool -> Source.StepT IO ByteString
2648: streamEventsStep tid sid lastId buffer sendExisting = case (sendExisting, buffer) of
2649:   -- Send buffered existing events first
2650:   (True, b : bs) -> Source.Yield b (streamEventsStep tid sid lastId bs True)
2651:   (True, []) -> streamEventsStep tid sid lastId [] False
2652:   -- Poll for new events
2653:   (False, _) ->
2654:     Source.Effect <| do
2655:       -- Check if task is still in progress
2656:       tasks <- TaskCore.loadTasks
2657:       let isComplete = case TaskCore.findTask tid tasks of
2658:             Nothing -> True
2659:             Just task -> TaskCore.taskStatus task /= TaskCore.InProgress
2660: 
2661:       if isComplete
2662:         then do
2663:           -- Send complete event and stop
2664:           let completeSSE = formatSSE "complete" "{}"
2665:           pure <| Source.Yield completeSSE Source.Stop
2666:         else do
2667:           -- Poll for new events
2668:           Concurrent.threadDelay 500000 -- 500ms
2669:           newEvents <- TaskCore.getEventsSince sid lastId
2670:           if null newEvents
2671:             then pure <| streamEventsStep tid sid lastId [] False
2672:             else do
2673:               let newLastId = maximum (map TaskCore.storedEventId newEvents)
2674:               let newSSE = map eventToSSE newEvents
2675:               case newSSE of
2676:                 (e : es) -> pure <| Source.Yield e (streamEventsStep tid sid newLastId es False)
2677:                 [] -> pure <| streamEventsStep tid sid newLastId [] False
2678: 
2679: -- | Convert a StoredEvent to SSE format
2680: eventToSSE :: TaskCore.StoredEvent -> ByteString
2681: eventToSSE event =
2682:   let eventType = Text.toLower (TaskCore.storedEventType event)
2683:       content = TaskCore.storedEventContent event
2684:       jsonData = case eventType of
2685:         "assistant" -> Aeson.object ["content" Aeson..= content]
2686:         "toolcall" ->
2687:           let (tool, args) = parseToolCallContent content
2688:            in Aeson.object ["tool" Aeson..= tool, "args" Aeson..= Aeson.object ["data" Aeson..= args]]
2689:         "toolresult" ->
2690:           Aeson.object ["tool" Aeson..= ("unknown" :: Text), "success" Aeson..= True, "output" Aeson..= content]
2691:         "cost" -> Aeson.object ["cost" Aeson..= content]
2692:         "error" -> Aeson.object ["error" Aeson..= content]
2693:         "complete" -> Aeson.object []
2694:         _ -> Aeson.object ["content" Aeson..= content]
2695:    in formatSSE eventType (str (Aeson.encode jsonData))
2696: 
2697: -- | Format an SSE message
2698: formatSSE :: Text -> ByteString -> ByteString
2699: formatSSE eventType jsonData =
2700:   str
2701:     <| "event: "
2702:     <> eventType
2703:     <> "\n"
2704:     <> "data: "
2705:     <> str jsonData
2706:     <> "\n\n"
2707: 
2708: api :: Proxy API
2709: api = Proxy
2710: 
2711: server :: Server API
2712: server =
2713:   homeHandler
2714:     :<|> styleHandler
2715:     :<|> readyQueueHandler
2716:     :<|> blockedHandler
2717:     :<|> interventionHandler
2718:     :<|> statsHandler
2719:     :<|> taskListHandler
2720:     :<|> kbHandler
2721:     :<|> factCreateHandler
2722:     :<|> factDetailHandler
2723:     :<|> factEditHandler
2724:     :<|> factDeleteHandler
2725:     :<|> epicsHandler
2726:     :<|> taskDetailHandler
2727:     :<|> taskStatusHandler
2728:     :<|> taskPriorityHandler
2729:     :<|> descriptionViewHandler
2730:     :<|> descriptionEditHandler
2731:     :<|> descriptionPostHandler
2732:     :<|> taskNotesHandler
2733:     :<|> taskCommentHandler
2734:     :<|> taskReviewHandler
2735:     :<|> taskDiffHandler
2736:     :<|> taskAcceptHandler
2737:     :<|> taskRejectHandler
2738:     :<|> taskResetRetriesHandler
2739:     :<|> recentActivityNewHandler
2740:     :<|> recentActivityMoreHandler
2741:     :<|> readyCountHandler
2742:     :<|> taskListPartialHandler
2743:     :<|> taskMetricsPartialHandler
2744:     :<|> agentEventsPartialHandler
2745:     :<|> taskEventsStreamHandler
2746:   where
2747:     styleHandler :: Servant.Handler LazyText.Text
2748:     styleHandler = pure Style.css
2749: 
2750:     homeHandler :: Maybe Text -> Servant.Handler HomePage
2751:     homeHandler maybeRangeText = do
2752:       now <- liftIO getCurrentTime
2753:       let range = parseTimeRange maybeRangeText
2754:           maybeStart = getTimeRangeStart range now
2755:       allTasks <- liftIO TaskCore.loadTasks
2756:       let filteredTasks = case maybeStart of
2757:             Nothing -> allTasks
2758:             Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start]
2759:           stats = TaskCore.computeTaskStatsFromList filteredTasks
2760:       readyTasks <- liftIO TaskCore.getReadyTasks
2761:       allActivities <- liftIO <| concat </ traverse (TaskCore.getActivitiesForTask <. TaskCore.taskId) allTasks
2762:       let filteredActivities = case maybeStart of
2763:             Nothing -> allActivities
2764:             Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start]
2765:           globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities
2766:           sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks
2767:           recentTasks = take 5 sortedTasks
2768:           hasMoreRecent = length filteredTasks > 5
2769:       pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now)
2770: 
2771:     readyQueueHandler :: Maybe Text -> Servant.Handler ReadyQueuePage
2772:     readyQueueHandler maybeSortText = do
2773:       now <- liftIO getCurrentTime
2774:       readyTasks <- liftIO TaskCore.getReadyTasks
2775:       let sortOrder = parseSortOrder maybeSortText
2776:           sortedTasks = sortTasks sortOrder readyTasks
2777:       pure (ReadyQueuePage sortedTasks sortOrder now)
2778: 
2779:     blockedHandler :: Maybe Text -> Servant.Handler BlockedPage
2780:     blockedHandler maybeSortText = do
2781:       now <- liftIO getCurrentTime
2782:       blockedTasks <- liftIO TaskCore.getBlockedTasks
2783:       allTasks <- liftIO TaskCore.loadTasks
2784:       let sortOrder = parseSortOrder maybeSortText
2785:           tasksWithImpact = [(t, TaskCore.getBlockingImpact allTasks t) | t <- blockedTasks]
2786:           sorted = List.sortBy (comparing (Down <. snd)) tasksWithImpact
2787:       pure (BlockedPage sorted sortOrder now)
2788: 
2789:     interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
2790:     interventionHandler maybeSortText = do
2791:       now <- liftIO getCurrentTime
2792:       actionItems <- liftIO TaskCore.getHumanActionItems
2793:       let sortOrder = parseSortOrder maybeSortText
2794:       pure (InterventionPage actionItems sortOrder now)
2795: 
2796:     statsHandler :: Maybe Text -> Servant.Handler StatsPage
2797:     statsHandler maybeEpic = do
2798:       let epicId = emptyToNothing maybeEpic
2799:       stats <- liftIO <| TaskCore.getTaskStats epicId
2800:       pure (StatsPage stats epicId)
2801: 
2802:     taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
2803:     taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
2804:       now <- liftIO getCurrentTime
2805:       allTasks <- liftIO TaskCore.loadTasks
2806:       let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
2807:           maybePriority = parsePriority =<< emptyToNothing maybePriorityText
2808:           maybeType = parseTaskType =<< emptyToNothing maybeTypeText
2809:           filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
2810:           sortOrder = parseSortOrder maybeSortText
2811:           filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
2812:       pure (TaskListPage filteredTasks filters sortOrder now)
2813: 
2814:     kbHandler :: Servant.Handler KBPage
2815:     kbHandler = do
2816:       facts <- liftIO Fact.getAllFacts
2817:       pure (KBPage facts)
2818: 
2819:     factCreateHandler :: FactCreateForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2820:     factCreateHandler (FactCreateForm project content filesText confText) = do
2821:       let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
2822:           confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
2823:       fid <- liftIO (Fact.createFact project content files Nothing confidence)
2824:       pure <| addHeader ("/kb/" <> tshow fid) NoContent
2825: 
2826:     factDetailHandler :: Int -> Servant.Handler FactDetailPage
2827:     factDetailHandler fid = do
2828:       now <- liftIO getCurrentTime
2829:       maybeFact <- liftIO (Fact.getFact fid)
2830:       case maybeFact of
2831:         Nothing -> pure (FactDetailNotFound fid)
2832:         Just fact -> pure (FactDetailFound fact now)
2833: 
2834:     factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2835:     factEditHandler fid (FactEditForm content filesText confText) = do
2836:       let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
2837:           confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
2838:       liftIO (Fact.updateFact fid content files confidence)
2839:       pure <| addHeader ("/kb/" <> tshow fid) NoContent
2840: 
2841:     factDeleteHandler :: Int -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2842:     factDeleteHandler fid = do
2843:       liftIO (Fact.deleteFact fid)
2844:       pure <| addHeader "/kb" NoContent
2845: 
2846:     epicsHandler :: Maybe Text -> Servant.Handler EpicsPage
2847:     epicsHandler maybeSortText = do
2848:       allTasks <- liftIO TaskCore.loadTasks
2849:       let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
2850:           sortOrder = parseSortOrder maybeSortText
2851:           sortedEpics = sortTasks sortOrder epicTasks
2852:       pure (EpicsPage sortedEpics allTasks sortOrder)
2853: 
2854:     parseStatus :: Text -> Maybe TaskCore.Status
2855:     parseStatus = readMaybe <. Text.unpack
2856: 
2857:     parsePriority :: Text -> Maybe TaskCore.Priority
2858:     parsePriority = readMaybe <. Text.unpack
2859: 
2860:     parseTaskType :: Text -> Maybe TaskCore.TaskType
2861:     parseTaskType = readMaybe <. Text.unpack
2862: 
2863:     emptyToNothing :: Maybe Text -> Maybe Text
2864:     emptyToNothing (Just t) | Text.null (Text.strip t) = Nothing
2865:     emptyToNothing x = x
2866: 
2867:     applyFilters :: TaskFilters -> [TaskCore.Task] -> [TaskCore.Task]
2868:     applyFilters filters = filter matchesAllFilters
2869:       where
2870:         matchesAllFilters task =
2871:           matchesStatus task
2872:             && matchesPriority task
2873:             && matchesNamespace task
2874:             && matchesType task
2875: 
2876:         matchesStatus task = case filterStatus filters of
2877:           Nothing -> True
2878:           Just s -> TaskCore.taskStatus task == s
2879: 
2880:         matchesPriority task = case filterPriority filters of
2881:           Nothing -> True
2882:           Just p -> TaskCore.taskPriority task == p
2883: 
2884:         matchesNamespace task = case filterNamespace filters of
2885:           Nothing -> True
2886:           Just ns -> case TaskCore.taskNamespace task of
2887:             Nothing -> False
2888:             Just taskNs -> ns `Text.isPrefixOf` taskNs
2889: 
2890:         matchesType task = case filterType filters of
2891:           Nothing -> True
2892:           Just t -> TaskCore.taskType task == t
2893: 
2894:     taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
2895:     taskDetailHandler tid = do
2896:       now <- liftIO getCurrentTime
2897:       tasks <- liftIO TaskCore.loadTasks
2898:       case TaskCore.findTask tid tasks of
2899:         Nothing -> pure (TaskDetailNotFound tid)
2900:         Just task -> do
2901:           activities <- liftIO (TaskCore.getActivitiesForTask tid)
2902:           retryCtx <- liftIO (TaskCore.getRetryContext tid)
2903:           commits <- liftIO (getCommitsForTask tid)
2904:           aggMetrics <-
2905:             if TaskCore.taskType task == TaskCore.Epic
2906:               then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
2907:               else pure Nothing
2908:           agentEvents <- liftIO (TaskCore.getAllEventsForTask tid)
2909:           pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now)
2910: 
2911:     taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
2912:     taskStatusHandler tid (StatusForm newStatus) = do
2913:       liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human
2914:       pure (StatusBadgePartial newStatus tid)
2915: 
2916:     taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
2917:     taskPriorityHandler tid (PriorityForm newPriority) = do
2918:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
2919:       pure (PriorityBadgePartial newPriority tid)
2920: 
2921:     descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
2922:     descriptionViewHandler tid = do
2923:       tasks <- liftIO TaskCore.loadTasks
2924:       case TaskCore.findTask tid tasks of
2925:         Nothing -> throwError err404
2926:         Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2927: 
2928:     descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial
2929:     descriptionEditHandler tid = do
2930:       tasks <- liftIO TaskCore.loadTasks
2931:       case TaskCore.findTask tid tasks of
2932:         Nothing -> throwError err404
2933:         Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2934: 
2935:     descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial
2936:     descriptionPostHandler tid (DescriptionForm desc) = do
2937:       let descText = Text.strip desc
2938:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
2939:       tasks <- liftIO TaskCore.loadTasks
2940:       case TaskCore.findTask tid tasks of
2941:         Nothing -> throwError err404
2942:         Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2943: 
2944:     taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2945:     taskNotesHandler tid (NotesForm notes) = do
2946:       liftIO <| TaskCore.updateRetryNotes tid notes
2947:       pure <| addHeader ("/tasks/" <> tid) NoContent
2948: 
2949:     taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2950:     taskCommentHandler tid (CommentForm commentText) = do
2951:       _ <- liftIO (TaskCore.addComment tid commentText TaskCore.Human)
2952:       pure <| addHeader ("/tasks/" <> tid) NoContent
2953: 
2954:     taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
2955:     taskReviewHandler tid = do
2956:       tasks <- liftIO TaskCore.loadTasks
2957:       case TaskCore.findTask tid tasks of
2958:         Nothing -> pure (ReviewPageNotFound tid)
2959:         Just task -> do
2960:           reviewInfo <- liftIO <| getReviewInfo tid
2961:           pure (ReviewPageFound task reviewInfo)
2962: 
2963:     taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage
2964:     taskDiffHandler tid commitSha = do
2965:       diffOutput <- liftIO <| getDiffForCommit commitSha
2966:       case diffOutput of
2967:         Nothing -> pure (DiffPageNotFound tid commitSha)
2968:         Just output -> pure (DiffPageFound tid commitSha output)
2969: 
2970:     taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2971:     taskAcceptHandler tid = do
2972:       liftIO <| do
2973:         TaskCore.clearRetryContext tid
2974:         TaskCore.updateTaskStatusWithActor tid TaskCore.Done [] TaskCore.Human
2975:       pure <| addHeader ("/tasks/" <> tid) NoContent
2976: 
2977:     taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2978:     taskRejectHandler tid (RejectForm maybeNotes) = do
2979:       liftIO <| do
2980:         maybeCommit <- findCommitForTask tid
2981:         let commitSha = fromMaybe "" maybeCommit
2982:         maybeCtx <- TaskCore.getRetryContext tid
2983:         let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
2984:         let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes
2985:         let accumulatedReason = case maybeCtx of
2986:               Nothing -> currentReason
2987:               Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
2988:         TaskCore.setRetryContext
2989:           TaskCore.RetryContext
2990:             { TaskCore.retryTaskId = tid,
2991:               TaskCore.retryOriginalCommit = commitSha,
2992:               TaskCore.retryConflictFiles = [],
2993:               TaskCore.retryAttempt = attempt,
2994:               TaskCore.retryReason = accumulatedReason,
2995:               TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
2996:             }
2997:         TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
2998:       pure <| addHeader ("/tasks/" <> tid) NoContent
2999: 
3000:     taskResetRetriesHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
3001:     taskResetRetriesHandler tid = do
3002:       liftIO <| do
3003:         TaskCore.clearRetryContext tid
3004:         TaskCore.updateTaskStatusWithActor tid TaskCore.Open [] TaskCore.Human
3005:       pure <| addHeader ("/tasks/" <> tid) NoContent
3006: 
3007:     recentActivityNewHandler :: Maybe Int -> Servant.Handler RecentActivityNewPartial
3008:     recentActivityNewHandler maybeSince = do
3009:       allTasks <- liftIO TaskCore.loadTasks
3010:       let sinceTime = maybe (posixSecondsToUTCTime 0) (posixSecondsToUTCTime <. fromIntegral) maybeSince
3011:           sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
3012:           newTasks = filter (\t -> TaskCore.taskUpdatedAt t > sinceTime) sortedTasks
3013:           newestTs = maybe maybeSince (Just <. taskToUnixTs) (head newTasks)
3014:       pure (RecentActivityNewPartial newTasks newestTs)
3015: 
3016:     recentActivityMoreHandler :: Maybe Int -> Servant.Handler RecentActivityMorePartial
3017:     recentActivityMoreHandler maybeOffset = do
3018:       allTasks <- liftIO TaskCore.loadTasks
3019:       let offset = fromMaybe 0 maybeOffset
3020:           pageSize = 5
3021:           sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
3022:           pageTasks = take pageSize <| drop offset sortedTasks
3023:           hasMore = length sortedTasks > offset + pageSize
3024:           nextOffset = offset + pageSize
3025:       pure (RecentActivityMorePartial pageTasks nextOffset hasMore)
3026: 
3027:     readyCountHandler :: Servant.Handler ReadyCountPartial
3028:     readyCountHandler = do
3029:       readyTasks <- liftIO TaskCore.getReadyTasks
3030:       pure (ReadyCountPartial (length readyTasks))
3031: 
3032:     taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
3033:     taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
3034:       allTasks <- liftIO TaskCore.loadTasks
3035:       let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
3036:           maybePriority = parsePriority =<< emptyToNothing maybePriorityText
3037:           maybeType = parseTaskType =<< emptyToNothing maybeTypeText
3038:           filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
3039:           sortOrder = parseSortOrder maybeSortText
3040:           filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
3041:       pure (TaskListPartial filteredTasks)
3042: 
3043:     taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
3044:     taskMetricsPartialHandler tid = do
3045:       now <- liftIO getCurrentTime
3046:       activities <- liftIO (TaskCore.getActivitiesForTask tid)
3047:       maybeRetry <- liftIO (TaskCore.getRetryContext tid)
3048:       pure (TaskMetricsPartial tid activities maybeRetry now)
3049: 
3050:     agentEventsPartialHandler :: Text -> Maybe Int -> Servant.Handler AgentEventsPartial
3051:     agentEventsPartialHandler tid _maybeSince = do
3052:       now <- liftIO getCurrentTime
3053:       events <- liftIO (TaskCore.getAllEventsForTask tid)
3054:       tasks <- liftIO TaskCore.loadTasks
3055:       let isInProgress = case TaskCore.findTask tid tasks of
3056:             Nothing -> False
3057:             Just task -> TaskCore.taskStatus task == TaskCore.InProgress
3058:       pure (AgentEventsPartial events isInProgress now)
3059: 
3060:     taskEventsStreamHandler :: Text -> Servant.Handler (SourceIO ByteString)
3061:     taskEventsStreamHandler tid = do
3062:       maybeSession <- liftIO (TaskCore.getLatestSessionForTask tid)
3063:       case maybeSession of
3064:         Nothing -> pure (Source.source [])
3065:         Just sid -> liftIO (streamAgentEvents tid sid)
3066: 
3067: taskToUnixTs :: TaskCore.Task -> Int
3068: taskToUnixTs t = round (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t))
3069: 
3070: getReviewInfo :: Text -> IO ReviewInfo
3071: getReviewInfo tid = do
3072:   maybeCommit <- findCommitForTask tid
3073:   case maybeCommit of
3074:     Nothing -> pure ReviewNoCommit
3075:     Just commitSha -> do
3076:       conflictResult <- checkMergeConflict (Text.unpack commitSha)
3077:       case conflictResult of
3078:         Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles)
3079:         Nothing -> do
3080:           (_, diffOut, _) <-
3081:             Process.readProcessWithExitCode
3082:               "git"
3083:               ["show", Text.unpack commitSha]
3084:               ""
3085:           pure (ReviewReady commitSha (Text.pack diffOut))
3086: 
3087: getDiffForCommit :: Text -> IO (Maybe Text)
3088: getDiffForCommit commitSha = do
3089:   (code, diffOut, _) <-
3090:     Process.readProcessWithExitCode
3091:       "git"
3092:       ["show", Text.unpack commitSha]
3093:       ""
3094:   case code of
3095:     Exit.ExitSuccess -> pure (Just (Text.pack diffOut))
3096:     Exit.ExitFailure _ -> pure Nothing
3097: 
3098: findCommitForTask :: Text -> IO (Maybe Text)
3099: findCommitForTask tid = do
3100:   let grepArg = "--grep=" <> Text.unpack tid
3101:   (code, shaOut, _) <-
3102:     Process.readProcessWithExitCode
3103:       "git"
3104:       ["log", "--pretty=format:%H", "-n", "1", grepArg]
3105:       ""
3106:   if code /= Exit.ExitSuccess || null shaOut
3107:     then pure Nothing
3108:     else case List.lines shaOut of
3109:       (x : _) -> pure (Just (Text.pack x))
3110:       [] -> pure Nothing
3111: 
3112: getCommitsForTask :: Text -> IO [GitCommit]
3113: getCommitsForTask tid = do
3114:   let grepArg = "--grep=Task-Id: " <> Text.unpack tid
3115:   (code, out, _) <-
3116:     Process.readProcessWithExitCode
3117:       "git"
3118:       ["log", "--pretty=format:%H|%h|%s|%an|%ar", grepArg]
3119:       ""
3120:   if code /= Exit.ExitSuccess || null out
3121:     then pure []
3122:     else do
3123:       let commitLines = filter (not <. null) (List.lines out)
3124:       traverse parseCommitLine commitLines
3125:   where
3126:     parseCommitLine :: String -> IO GitCommit
3127:     parseCommitLine line =
3128:       case Text.splitOn "|" (Text.pack line) of
3129:         [sha, shortSha, summary, author, relDate] -> do
3130:           filesCount <- getFilesChangedCount (Text.unpack sha)
3131:           pure
3132:             GitCommit
3133:               { commitHash = sha,
3134:                 commitShortHash = shortSha,
3135:                 commitSummary = summary,
3136:                 commitAuthor = author,
3137:                 commitRelativeDate = relDate,
3138:                 commitFilesChanged = filesCount
3139:               }
3140:         _ ->
3141:           pure
3142:             GitCommit
3143:               { commitHash = Text.pack line,
3144:                 commitShortHash = Text.take 7 (Text.pack line),
3145:                 commitSummary = "(parse error)",
3146:                 commitAuthor = "",
3147:                 commitRelativeDate = "",
3148:                 commitFilesChanged = 0
3149:               }
3150: 
3151:     getFilesChangedCount :: String -> IO Int
3152:     getFilesChangedCount sha = do
3153:       (code', out', _) <-
3154:         Process.readProcessWithExitCode
3155:           "git"
3156:           ["show", "--stat", "--format=", sha]
3157:           ""
3158:       pure
3159:         <| if code' /= Exit.ExitSuccess
3160:           then 0
3161:           else
3162:             let statLines = filter (not <. null) (List.lines out')
3163:              in max 0 (length statLines - 1)
3164: 
3165: checkMergeConflict :: String -> IO (Maybe [Text])
3166: checkMergeConflict commitSha = do
3167:   (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""
3168: 
3169:   (cpCode, _, cpErr) <-
3170:     Process.readProcessWithExitCode
3171:       "git"
3172:       ["cherry-pick", "--no-commit", commitSha]
3173:       ""
3174: 
3175:   _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
3176:   _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""
3177: 
3178:   case cpCode of
3179:     Exit.ExitSuccess -> pure Nothing
3180:     Exit.ExitFailure _ -> do
3181:       let errLines = Text.lines (Text.pack cpErr)
3182:           conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
3183:           files = mapMaybe extractConflictFile conflictLines
3184:       pure (Just (if null files then ["(unknown files)"] else files))
3185: 
3186: extractConflictFile :: Text -> Maybe Text
3187: extractConflictFile line =
3188:   case Text.breakOn "Merge conflict in " line of
3189:     (_, rest)
3190:       | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
3191:     _ -> case Text.breakOn "in " line of
3192:       (_, rest)
3193:         | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
3194:       _ -> Nothing
3195: 
3196: app :: Application
3197: app = serve api server
3198: 
3199: run :: Warp.Port -> IO ()
3200: run port = do
3201:   TaskCore.initTaskDb
3202:   putText <| "Starting Jr web server on port " <> tshow port
3203:   Warp.run port app

30: -- Core data types
31: data Task = Task
32:   { taskId :: Text,
33:     taskTitle :: Text,
34:     taskType :: TaskType,
35:     taskParent :: Maybe Text, -- Parent epic ID
36:     taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud")
37:     taskStatus :: Status,
38:     taskPriority :: Priority, -- Priority level (0-4)
39:     taskComplexity :: Maybe Int, -- Complexity 1-5 for model selection
40:     taskDependencies :: [Dependency], -- List of dependencies with types
41:     taskDescription :: Text, -- Required description
42:     taskComments :: [Comment], -- Timestamped comments for extra context
43:     taskCreatedAt :: UTCTime,
44:     taskUpdatedAt :: UTCTime
45:   }
46:   deriving (Show, Eq, Generic)
47: 
48: data TaskType = Epic | WorkTask | HumanTask
49:   deriving (Show, Eq, Read, Generic)
50: 
51: data Status = Draft | Open | InProgress | Review | Approved | Done
52:   deriving (Show, Eq, Read, Generic)
53: 
54: -- Priority levels (matching beads convention)
55: data Priority = P0 | P1 | P2 | P3 | P4
56:   deriving (Show, Eq, Ord, Read, Generic)
57: 
58: data Dependency = Dependency
59:   { depId :: Text, -- ID of the task this depends on
60:     depType :: DependencyType -- Type of dependency relationship

1515:               renderRetryContextBanner (TaskCore.taskId task) maybeRetry
1516: 
1517:               Lucid.div_ [Lucid.class_ "task-detail"] <| do
1518:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1519:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1520:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1521:                     metaSep
1522:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1523:                     metaSep
1524:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                     metaSep
1526:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1527:                     case TaskCore.taskNamespace task of
1528:                       Nothing -> pure ()
1529:                       Just ns -> do
1530:                         metaSep
1531:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
1532: 
1533:                   Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
1534:                     case TaskCore.taskParent task of
1535:                       Nothing -> pure ()

674: statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675: statusBadge status =
676:   let (cls, label) = case status of
677:         TaskCore.Draft -> ("badge badge-draft", "Draft")
678:         TaskCore.Open -> ("badge badge-open", "Open")
679:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
680:         TaskCore.Review -> ("badge badge-review", "Review")
681:         TaskCore.Approved -> ("badge badge-approved", "Approved")
682:         TaskCore.Done -> ("badge badge-done", "Done")
683:    in Lucid.span_ [Lucid.class_ cls] label
684: 

1: # Omni
2: 
3: The Omni project is to leverage automation and asymmetries to create wealth.
4: 
5: ## Critical Rules for AI Agents
6: 
7: **CRITICAL**: This project uses `jr task` for ALL issue tracking. You MUST follow these rules:
8: 
9: - ✅ Use `jr task` for ALL task/TODO tracking (`jr task create ... --json`)
10: - ✅ Link discovered work with `--discovered-from=<parent-id>`
11: - ✅ File bugs IMMEDIATELY when you discover unexpected behavior
12: - ✅ Add facts to the knowledge base when you learn something useful (`jr facts add ...`)
13: - ✅ Run `jr task ready --json` before asking "what should I work on?"
14: - ✅ Store AI planning docs in `_/llm` directory (NEVER in repo root)
15: - ❌ Do NOT use `todo_write` tool
16: - ❌ Do NOT create markdown TODO lists or task checklists
17: - ❌ Do NOT put TODO/FIXME comments in code
18: 
19: ## Cheat Sheet
20: 
21: **Standard workflow:**
22: ```bash
23: # 1. Find ready work
24: jr task ready --json
25: 
26: # 2. Claim a task
27: jr task update <id> in-progress --json
28: 
29: # 3. During work: create discovered issues
30: jr task create "Fix type error found" --discovered-from=<current-id> --json
31: 
32: # 4. Complete the task
33: jr task update <id> done --json
34: ```
35: 
36: **Bug Discovery:**
37: ```bash
38: # Create a task immediately
39: jr task create "Command X fails when Y" --discovered-from=<current-task-id> --json
40: ```
41: 
42: ## Directory Structure
43: 
44: - **`_/`** (cabdir) - All ephemeral/generated files. This directory is gitignored.
45:   - `_/llm/` - AI planning docs and agent logs
46:   - `_/tmp/` - Temporary files, test databases, scratch data
47: - Never create dotfile directories (like `.tasks/`) in the repo root
48: 
49: ## Common Commands
50: 
51: **Build:**
52: ```bash
53: bild Omni/Jr.hs              # Build a Haskell namespace
54: bild Biz/Cloud/Api.py        # Build a Python namespace
55: ```
56: 
57: **Lint and Format:**
58: ```bash
59: lint Omni/Cli.hs             # Lint a file (DO NOT use hlint directly)
60: lint --fix **/*.py           # Lint and auto-fix Python files
61: ```
62: 
63: **Type Check:**
64: ```bash
65: typecheck.sh Omni/Bild/Example.py   # Run mypy on Python files
66: ```
67: 
68: **Test:**
69: ```bash
70: bild --test Omni/Jr.hs       # Build and run tests for a namespace
71: ```
72: 
73: **Run:**
74: ```bash
75: Omni/Ide/run.sh Omni/Jr.hs   # Build (if needed) and run
76: ```
77: 
78: ## Documentation
79: 
80: - **Project Context**: [README.md](README.md) - Goals, source layout, and coding conventions.
81: - **Task Manager**: [`Omni/Task/README.md`](Omni/Task/README.md) - Detailed usage, dependency management, and agent best practices.
82: - **Build Tool (Bild)**: [`Omni/Bild/README.md`](Omni/Bild/README.md) - How to use `bild` and manage dependencies.
83: - **Development Tools**: [`Omni/Ide/README.md`](Omni/Ide/README.md) - `run.sh`, `lint`, `repl.sh`, git workflow.

./Omni/Jr/Web.hs:635:      taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
./Omni/Jr/Web.hs:809:          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
./Omni/Jr/Web.hs:882:          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
./Omni/Jr/Web.hs:901:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:914:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:929:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:1112:          [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
./Omni/Jr/Web.hs:1122:            Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
./Omni/Jr/Web.hs:1304:                    Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid)
./Omni/Jr/Web.hs:1395:          Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:1538:                        Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
./Omni/Jr/Web.hs:1590:                    [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
./Omni/Jr/Web.hs:1600:          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
./Omni/Jr/Web.hs:1606:          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
./Omni/Jr/Web.hs:1615:              [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
./Omni/Jr/Web.hs:1803:        Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
./Omni/Jr/Web.hs:1822:    let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
./Omni/Jr/Web.hs:1834:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
./Omni/Jr/Web.hs:1877:                        Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
./Omni/Jr/Web.hs:1885:                        Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
./Omni/Jr/Web.hs:1901:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
./Omni/Jr/Web.hs:1910:              Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
./Omni/Jr/Web.hs:1913:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
./Omni/Jr/Web.hs:1919:                Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
./Omni/Jr/Web.hs:2184:            Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"),
./Omni/Jr/Web.hs:2202:            Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"),
./Omni/Jr/Web.hs:2209:        [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"),
./Omni/Jr/Web.hs:2340:      Lucid.action_ ("/tasks/" <> tid <> "/comment"),
./Omni/Jr/Web.hs:2947:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2952:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2975:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2998:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:3005:      pure <| addHeader ("/tasks/" <> tid) NoContent

./Omni/Jr/Web.hs
./Omni/Jr/Web/Style.hs
./Omni/Jr.hs
./.git/branchless/test/worktrees/testing-worktree-1/Omni/Jr/Web.hs
./.git/branchless/test/worktrees/testing-worktree-1/Omni/Jr/Fact.hs
./.git/branchless/test/worktrees/testing-worktree-1/Omni/Jr/Web/Style.hs
./.git/branchless/test/worktrees/testing-worktree-1/Omni/Jr.hs
./.git/branchless/test/worktrees/testing-worktree-4/Omni/Jr/Web.hs
./.git/branchless/test/worktrees/testing-worktree-4/Omni/Jr/Fact.hs
./.git/branchless/test/worktrees/testing-worktree-4/Omni/Jr/Web/Style.hs
./.git/branchless/test/worktrees/testing-worktree-4/Omni/Jr.hs
./.git/branchless/test/worktrees/testing-worktree-3/Omni/Jr/Web.hs
./.git/branchless/test/worktrees/testing-worktree-3/Omni/Jr/Fact.hs
./.git/branchless/test/worktrees/testing-worktree-3/Omni/Jr/Web/Style.hs
./.git/branchless/test/worktrees/testing-worktree-3/Omni/Jr.hs
./.git/branchless/test/worktrees/testing-worktree-2/Omni/Jr/Web.hs
./.git/branchless/test/worktrees/testing-worktree-2/Omni/Jr/Fact.hs
./.git/branchless/test/worktrees/testing-worktree-2/Omni/Jr/Web/Style.hs
./.git/branchless/test/worktrees/testing-worktree-2/Omni/Jr.hs

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE TypeOperators #-}
4: {-# LANGUAGE NoImplicitPrelude #-}
5: 
6: -- : dep warp
7: -- : dep servant-server
8: -- : dep lucid
9: -- : dep servant-lucid
10: -- : dep http-api-data
11: -- : dep process
12: -- : dep clay
13: module Omni.Jr.Web
14:   ( run,
15:     defaultPort,
16:   )
17: where
18: 
19: import Alpha
20: import qualified Control.Concurrent as Concurrent
21: import qualified Data.Aeson as Aeson
22: import qualified Data.Aeson.KeyMap as KeyMap
23: import qualified Data.ByteString.Lazy as LBS
24: import qualified Data.List as List
25: import qualified Data.Text as Text
26: import qualified Data.Text.Lazy as LazyText
27: import qualified Data.Text.Lazy.Encoding as LazyText
28: import Data.Time (Day, NominalDiffTime, UTCTime (..), dayOfWeek, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime, toGregorian)
29: import Data.Time.Calendar (DayOfWeek (..))
30: import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
31: import qualified Lucid
32: import qualified Lucid.Base as Lucid
33: import qualified Network.Wai.Handler.Warp as Warp
34: import Numeric (showFFloat)
35: import qualified Omni.Fact as Fact
36: import qualified Omni.Jr.Web.Style as Style
37: import qualified Omni.Task.Core as TaskCore
38: import Servant
39: import qualified Servant.HTML.Lucid as Lucid
40: import qualified Servant.Types.SourceT as Source
41: import qualified System.Exit as Exit
42: import qualified System.Process as Process
43: import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
44: 
45: type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
46: 
47: defaultPort :: Warp.Port
48: defaultPort = 8080
49: 
50: formatRelativeTime :: UTCTime -> UTCTime -> Text
51: formatRelativeTime now timestamp =
52:   let delta = diffUTCTime now timestamp
53:    in relativeText delta
54: 
55: relativeText :: NominalDiffTime -> Text
56: relativeText delta
57:   | delta < 60 = "just now"
58:   | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
59:   | delta < 7200 = "1 hour ago"
60:   | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
61:   | delta < 172800 = "yesterday"
62:   | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
63:   | delta < 1209600 = "1 week ago"
64:   | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
65:   | delta < 5184000 = "1 month ago"
66:   | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
67:   | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"
68: 
69: formatExactTimestamp :: UTCTime -> Text
70: formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
71: 
72: renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
73: renderRelativeTimestamp now timestamp =
74:   Lucid.span_
75:     [ Lucid.class_ "relative-time",
76:       Lucid.title_ (formatExactTimestamp timestamp)
77:     ]
78:     (Lucid.toHtml (formatRelativeTime now timestamp))
79: 
80: metaSep :: (Monad m) => Lucid.HtmlT m ()
81: metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
82: 
83: data TaskFilters = TaskFilters
84:   { filterStatus :: Maybe TaskCore.Status,
85:     filterPriority :: Maybe TaskCore.Priority,
86:     filterNamespace :: Maybe Text,
87:     filterType :: Maybe TaskCore.TaskType
88:   }
89:   deriving (Show, Eq)
90: 
91: data TimeRange = Today | Week | Month | AllTime
92:   deriving (Show, Eq)
93: 
94: data SortOrder
95:   = SortNewest
96:   | SortOldest
97:   | SortUpdated
98:   | SortPriorityHigh
99:   | SortPriorityLow
100:   deriving (Show, Eq)

2894:     taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
2895:     taskDetailHandler tid = do
2896:       now <- liftIO getCurrentTime
2897:       tasks <- liftIO TaskCore.loadTasks
2898:       case TaskCore.findTask tid tasks of
2899:         Nothing -> pure (TaskDetailNotFound tid)
2900:         Just task -> do
2901:           activities <- liftIO (TaskCore.getActivitiesForTask tid)
2902:           retryCtx <- liftIO (TaskCore.getRetryContext tid)
2903:           commits <- liftIO (getCommitsForTask tid)
2904:           aggMetrics <-
2905:             if TaskCore.taskType task == TaskCore.Epic
2906:               then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
2907:               else pure Nothing
2908:           agentEvents <- liftIO (TaskCore.getAllEventsForTask tid)
2909:           pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics agentEvents now)
2910: 
2911:     taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
2912:     taskStatusHandler tid (StatusForm newStatus) = do
2913:       liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human
2914:       pure (StatusBadgePartial newStatus tid)
2915: 
2916:     taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
2917:     taskPriorityHandler tid (PriorityForm newPriority) = do
2918:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
2919:       pure (PriorityBadgePartial newPriority tid)
2920: 
2921:     descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
2922:     descriptionViewHandler tid = do
2923:       tasks <- liftIO TaskCore.loadTasks
2924:       case TaskCore.findTask tid tasks of
2925:         Nothing -> throwError err404
2926:         Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2927: 
2928:     descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial
2929:     descriptionEditHandler tid = do
2930:       tasks <- liftIO TaskCore.loadTasks
2931:       case TaskCore.findTask tid tasks of
2932:         Nothing -> throwError err404
2933:         Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2934: 
2935:     descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial
2936:     descriptionPostHandler tid (DescriptionForm desc) = do
2937:       let descText = Text.strip desc
2938:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
2939:       tasks <- liftIO TaskCore.loadTasks
2940:       case TaskCore.findTask tid tasks of
2941:         Nothing -> throwError err404
2942:         Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
2943: 
2944:     taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2945:     taskNotesHandler tid (NotesForm notes) = do
2946:       liftIO <| TaskCore.updateRetryNotes tid notes
2947:       pure <| addHeader ("/tasks/" <> tid) NoContent
2948: 
2949:     taskCommentHandler :: Text -> CommentForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
2950:     taskCommentHandler tid (CommentForm commentText) = do

1: # Omni
2: 
3: The Omni project is to leverage automation and asymmetries to create wealth.
4: 
5: ## Critical Rules for AI Agents
6: 
7: **CRITICAL**: This project uses `jr task` for ALL issue tracking. You MUST follow these rules:
8: 
9: - ✅ Use `jr task` for ALL task/TODO tracking (`jr task create ... --json`)
10: - ✅ Link discovered work with `--discovered-from=<parent-id>`
11: - ✅ File bugs IMMEDIATELY when you discover unexpected behavior
12: - ✅ Add facts to the knowledge base when you learn something useful (`jr facts add ...`)
13: - ✅ Run `jr task ready --json` before asking "what should I work on?"
14: - ✅ Store AI planning docs in `_/llm` directory (NEVER in repo root)
15: - ❌ Do NOT use `todo_write` tool
16: - ❌ Do NOT create markdown TODO lists or task checklists
17: - ❌ Do NOT put TODO/FIXME comments in code
18: 
19: ## Cheat Sheet
20: 
21: **Standard workflow:**
22: ```bash
23: # 1. Find ready work
24: jr task ready --json
25: 
26: # 2. Claim a task
27: jr task update <id> in-progress --json
28: 
29: # 3. During work: create discovered issues
30: jr task create "Fix type error found" --discovered-from=<current-id> --json
31: 
32: # 4. Complete the task
33: jr task update <id> done --json
34: ```
35: 
36: **Bug Discovery:**
37: ```bash
38: # Create a task immediately
39: jr task create "Command X fails when Y" --discovered-from=<current-task-id> --json
40: ```
41: 
42: ## Directory Structure
43: 
44: - **`_/`** (cabdir) - All ephemeral/generated files. This directory is gitignored.
45:   - `_/llm/` - AI planning docs and agent logs
46:   - `_/tmp/` - Temporary files, test databases, scratch data
47: - Never create dotfile directories (like `.tasks/`) in the repo root
48: 
49: ## Common Commands
50: 
51: **Build:**
52: ```bash
53: bild Omni/Jr.hs              # Build a Haskell namespace
54: bild Biz/Cloud/Api.py        # Build a Python namespace
55: ```
56: 
57: **Lint and Format:**
58: ```bash
59: lint Omni/Cli.hs             # Lint a file (DO NOT use hlint directly)
60: lint --fix **/*.py           # Lint and auto-fix Python files
61: ```
62: 
63: **Type Check:**
64: ```bash
65: typecheck.sh Omni/Bild/Example.py   # Run mypy on Python files
66: ```
67: 
68: **Test:**
69: ```bash
70: bild --test Omni/Jr.hs       # Build and run tests for a namespace
71: ```
72: 
73: **Run:**
74: ```bash
75: Omni/Ide/run.sh Omni/Jr.hs   # Build (if needed) and run
76: ```
77: 
78: ## Documentation
79: 
80: - **Project Context**: [README.md](README.md) - Goals, source layout, and coding conventions.
81: - **Task Manager**: [`Omni/Task/README.md`](Omni/Task/README.md) - Detailed usage, dependency management, and agent best practices.
82: - **Build Tool (Bild)**: [`Omni/Bild/README.md`](Omni/Bild/README.md) - How to use `bild` and manage dependencies.
83: - **Development Tools**: [`Omni/Ide/README.md`](Omni/Ide/README.md) - `run.sh`, `lint`, `repl.sh`, git workflow.

./Omni/Jr/Web.hs:635:      taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
./Omni/Jr/Web.hs:809:          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
./Omni/Jr/Web.hs:882:          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
./Omni/Jr/Web.hs:901:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:914:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:929:      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:1112:          [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
./Omni/Jr/Web.hs:1122:            Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
./Omni/Jr/Web.hs:1304:                    Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid)
./Omni/Jr/Web.hs:1395:          Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
./Omni/Jr/Web.hs:1538:                        Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
./Omni/Jr/Web.hs:1590:                    [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
./Omni/Jr/Web.hs:1600:          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
./Omni/Jr/Web.hs:1606:          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
./Omni/Jr/Web.hs:1615:              [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
./Omni/Jr/Web.hs:1803:        Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
./Omni/Jr/Web.hs:1822:    let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
./Omni/Jr/Web.hs:1834:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
./Omni/Jr/Web.hs:1877:                        Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
./Omni/Jr/Web.hs:1885:                        Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
./Omni/Jr/Web.hs:1901:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
./Omni/Jr/Web.hs:1910:              Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
./Omni/Jr/Web.hs:1913:        crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
./Omni/Jr/Web.hs:1919:                Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
./Omni/Jr/Web.hs:2184:            Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/edit"),
./Omni/Jr/Web.hs:2202:            Lucid.makeAttribute "hx-get" ("/tasks/" <> tid <> "/description/view"),
./Omni/Jr/Web.hs:2209:        [ Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/description"),
./Omni/Jr/Web.hs:2340:      Lucid.action_ ("/tasks/" <> tid <> "/comment"),
./Omni/Jr/Web.hs:2947:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2952:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2975:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:2998:      pure <| addHeader ("/tasks/" <> tid) NoContent
./Omni/Jr/Web.hs:3005:      pure <| addHeader ("/tasks/" <> tid) NoContent

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE TypeOperators #-}
4: {-# LANGUAGE NoImplicitPrelude #-}
5: 
6: -- : dep warp
7: -- : dep servant-server
8: -- : dep lucid
9: -- : dep servant-lucid
10: -- : dep http-api-data
11: -- : dep process
12: -- : dep clay
13: module Omni.Jr.Web
14:   ( run,
15:     defaultPort,
16:   )
17: where
18: 
19: import Alpha
20: import qualified Control.Concurrent as Concurrent
21: import qualified Data.Aeson as Aeson
22: import qualified Data.Aeson.KeyMap as KeyMap
23: import qualified Data.ByteString.Lazy as LBS
24: import qualified Data.List as List
25: import qualified Data.Text as Text
26: import qualified Data.Text.Lazy as LazyText
27: import qualified Data.Text.Lazy.Encoding as LazyText
28: import Data.Time (Day, NominalDiffTime, UTCTime (..), dayOfWeek, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime, toGregorian)
29: import Data.Time.Calendar (DayOfWeek (..))
30: import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
31: import qualified Lucid
32: import qualified Lucid.Base as Lucid
33: import qualified Network.Wai.Handler.Warp as Warp
34: import Numeric (showFFloat)
35: import qualified Omni.Fact as Fact
36: import qualified Omni.Jr.Web.Style as Style
37: import qualified Omni.Task.Core as TaskCore
38: import Servant
39: import qualified Servant.HTML.Lucid as Lucid
40: import qualified Servant.Types.SourceT as Source
41: import qualified System.Exit as Exit
42: import qualified System.Process as Process
43: import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
44: 
45: type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
46: 
47: defaultPort :: Warp.Port
48: defaultPort = 8080
49: 
50: formatRelativeTime :: UTCTime -> UTCTime -> Text
51: formatRelativeTime now timestamp =
52:   let delta = diffUTCTime now timestamp
53:    in relativeText delta
54: 
55: relativeText :: NominalDiffTime -> Text
56: relativeText delta
57:   | delta < 60 = "just now"
58:   | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
59:   | delta < 7200 = "1 hour ago"
60:   | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
61:   | delta < 172800 = "yesterday"
62:   | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
63:   | delta < 1209600 = "1 week ago"
64:   | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
65:   | delta < 5184000 = "1 month ago"
66:   | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
67:   | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"
68: 
69: formatExactTimestamp :: UTCTime -> Text
70: formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"
71: 
72: renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
73: renderRelativeTimestamp now timestamp =
74:   Lucid.span_
75:     [ Lucid.class_ "relative-time",
76:       Lucid.title_ (formatExactTimestamp timestamp)
77:     ]
78:     (Lucid.toHtml (formatRelativeTime now timestamp))
79: 
80: metaSep :: (Monad m) => Lucid.HtmlT m ()
81: metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"
82: 
83: data TaskFilters = TaskFilters
84:   { filterStatus :: Maybe TaskCore.Status,
85:     filterPriority :: Maybe TaskCore.Priority,
86:     filterNamespace :: Maybe Text,
87:     filterType :: Maybe TaskCore.TaskType
88:   }
89:   deriving (Show, Eq)
90: 
91: data TimeRange = Today | Week | Month | AllTime
92:   deriving (Show, Eq)
93: 
94: data SortOrder
95:   = SortNewest
96:   | SortOldest
97:   | SortUpdated
98:   | SortPriorityHigh
99:   | SortPriorityLow
100:   deriving (Show, Eq)

./Omni/Jr/Web/Style.hs:7:    statusBadgeClass,
./Omni/Jr/Web/Style.hs:8:    priorityBadgeClass,
./Omni/Jr/Web/Style.hs:30:  statusBadges
./Omni/Jr/Web/Style.hs:563:statusBadges :: Css
./Omni/Jr/Web/Style.hs:564:statusBadges = do
./Omni/Jr/Web/Style.hs:2036:statusBadgeClass :: Text -> Text
./Omni/Jr/Web/Style.hs:2037:statusBadgeClass status = case status of
./Omni/Jr/Web/Style.hs:2045:priorityBadgeClass :: Text -> Text
./Omni/Jr/Web/Style.hs:2046:priorityBadgeClass priority = case priority of
./Omni/Jr/Web.hs:225:    :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
./Omni/Jr/Web.hs:226:    :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
./Omni/Jr/Web.hs:340:data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
./Omni/Jr/Web.hs:342:data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
./Omni/Jr/Web.hs:674:statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:675:statusBadge status =
./Omni/Jr/Web.hs:748:statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:749:statusBadgeWithForm status tid =
./Omni/Jr/Web.hs:824:priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:825:priorityBadgeWithForm priority tid =
./Omni/Jr/Web.hs:831:      clickablePriorityBadge priority tid
./Omni/Jr/Web.hs:834:clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:835:clickablePriorityBadge priority _tid =
./Omni/Jr/Web.hs:906:        statusBadge (TaskCore.taskStatus t)
./Omni/Jr/Web.hs:919:        statusBadge (TaskCore.taskStatus t)
./Omni/Jr/Web.hs:936:        statusBadge (TaskCore.taskStatus t)
./Omni/Jr/Web.hs:1400:            statusBadge (TaskCore.taskStatus t)
./Omni/Jr/Web.hs:1524:                    statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
./Omni/Jr/Web.hs:1526:                    priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
./Omni/Jr/Web.hs:1850:                  Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
./Omni/Jr/Web.hs:2065:instance Lucid.ToHtml StatusBadgePartial where
./Omni/Jr/Web.hs:2067:  toHtml (StatusBadgePartial status tid) =
./Omni/Jr/Web.hs:2068:    statusBadgeWithForm status tid
./Omni/Jr/Web.hs:2070:instance Lucid.ToHtml PriorityBadgePartial where
./Omni/Jr/Web.hs:2072:  toHtml (PriorityBadgePartial priority tid) =
./Omni/Jr/Web.hs:2073:    priorityBadgeWithForm priority tid
./Omni/Jr/Web.hs:2911:    taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
./Omni/Jr/Web.hs:2914:      pure (StatusBadgePartial newStatus tid)
./Omni/Jr/Web.hs:2916:    taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
./Omni/Jr/Web.hs:2919:      pure (PriorityBadgePartial newPriority tid)

1500:           pageBodyWithCrumbs crumbs <| do
1501:             Lucid.div_ [Lucid.class_ "container"] <| do
1502:               Lucid.h1_ "Task Not Found"
1503:               Lucid.p_ <| do
1504:                 "The task "
1505:                 Lucid.code_ (Lucid.toHtml tid)
1506:                 " could not be found."
1507:   toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics agentEvents now) =
1508:     let crumbs = taskBreadcrumbs allTasks task
1509:      in Lucid.doctypehtml_ <| do
1510:           pageHead (TaskCore.taskId task <> " - Jr")
1511:           pageBodyWithCrumbs crumbs <| do
1512:             Lucid.div_ [Lucid.class_ "container"] <| do
1513:               Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
1514: 
1515:               renderRetryContextBanner (TaskCore.taskId task) maybeRetry
1516: 
1517:               Lucid.div_ [Lucid.class_ "task-detail"] <| do
1518:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1519:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1520:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1521:                     metaSep
1522:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1523:                     metaSep
1524:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1525:                     metaSep
1526:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1527:                     case TaskCore.taskNamespace task of
1528:                       Nothing -> pure ()
1529:                       Just ns -> do
1530:                         metaSep
1531:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
1532: 
1533:                   Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
1534:                     case TaskCore.taskParent task of
1535:                       Nothing -> pure ()
1536:                       Just pid -> do
1537:                         Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
1538:                         Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
1539:                         metaSep
1540:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
1541:                     renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
1542:                     metaSep
1543:                     Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
1544:                     renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
1545: 
1546:                 let deps = TaskCore.taskDependencies task
1547:                 unless (null deps) <| do
1548:                   Lucid.div_ [Lucid.class_ "detail-section"] <| do
1549:                     Lucid.h3_ "Dependencies"
1550:                     Lucid.ul_ [Lucid.class_ "dep-list"] <| do
1551:                       traverse_ renderDependency deps
1552: 
1553:                 when (TaskCore.taskType task == TaskCore.Epic) <| do
1554:                   for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
1555: 
1556:                 Lucid.div_ [Lucid.class_ "detail-section"] <| do
1557:                   Lucid.toHtml (DescriptionViewPartial (TaskCore.taskId task) (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
1558: 
1559:                 let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
1560:                 unless (null children) <| do

31: data Task = Task
32:   { taskId :: Text,
33:     taskTitle :: Text,
34:     taskType :: TaskType,
35:     taskParent :: Maybe Text, -- Parent epic ID
36:     taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud")
37:     taskStatus :: Status,
38:     taskPriority :: Priority, -- Priority level (0-4)
39:     taskComplexity :: Maybe Int, -- Complexity 1-5 for model selection
40:     taskDependencies :: [Dependency], -- List of dependencies with types
41:     taskDescription :: Text, -- Required description
42:     taskComments :: [Comment], -- Timestamped comments for extra context
43:     taskCreatedAt :: UTCTime,
44:     taskUpdatedAt :: UTCTime
45:   }
46:   deriving (Show, Eq, Generic)
47: 
48: data TaskType = Epic | WorkTask | HumanTask
49:   deriving (Show, Eq, Read, Generic)
50: 

824: priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
825: priorityBadgeWithForm priority tid =
826:   Lucid.div_
827:     [ Lucid.id_ "priority-badge-container",
828:       Lucid.class_ "priority-badge-dropdown"
829:     ]
830:     <| do
831:       clickablePriorityBadge priority tid
832:       priorityDropdownOptions priority tid
833: 
834: clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
835: clickablePriorityBadge priority _tid =
836:   let (cls, label) = case priority of
837:         TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
838:         TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
839:         TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
840:         TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
841:         TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
842:    in Lucid.span_
843:         [ Lucid.class_ cls,
844:           Lucid.tabindex_ "0",
845:           Lucid.role_ "button",
846:           Lucid.makeAttribute "aria-haspopup" "true",
847:           Lucid.makeAttribute "aria-expanded" "false",
848:           Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
849:           Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
850:         ]
851:         <| do
852:           Lucid.toHtml label
853:           Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
854: 
855: priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
856: priorityDropdownOptions currentPriority tid =
857:   Lucid.div_
858:     [ Lucid.class_ "priority-dropdown-menu",
859:       Lucid.role_ "menu",
860:       Lucid.makeAttribute "aria-label" "Change task priority"
861:     ]
862:     <| do
863:       priorityOption TaskCore.P0 currentPriority tid
864:       priorityOption TaskCore.P1 currentPriority tid
865:       priorityOption TaskCore.P2 currentPriority tid
866:       priorityOption TaskCore.P3 currentPriority tid
867:       priorityOption TaskCore.P4 currentPriority tid
868: 
869: priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
870: priorityOption opt currentPriority tid =
871:   let (cls, label) = case opt of
872:         TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
873:         TaskCore.P1 -> ("badge badge-p1", "P1 High")
874:         TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
875:         TaskCore.P3 -> ("badge badge-p3", "P3 Low")
876:         TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
877:       isSelected = opt == currentPriority
878:       optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
879:    in Lucid.form_
880:         [ Lucid.class_ "priority-option-form",
881:           Lucid.role_ "none",
882:           Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
883:           Lucid.makeAttribute "hx-target" "#priority-badge-container",
884:           Lucid.makeAttribute "hx-swap" "outerHTML"
885:         ]
886:         <| do
887:           Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
888:           Lucid.button_
889:             [ Lucid.type_ "submit",
890:               Lucid.class_ optClass,
891:               Lucid.role_ "menuitem",
892:               Lucid.tabindex_ "-1",
893:               Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
894:             ]
895:             (Lucid.toHtml label)
896: 
897: renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
898: renderTaskCard t =
899:   Lucid.a_
900:     [ Lucid.class_ "task-card task-card-link",

674: statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675: statusBadge status =
676:   let (cls, label) = case status of
677:         TaskCore.Draft -> ("badge badge-draft", "Draft")
678:         TaskCore.Open -> ("badge badge-open", "Open")
679:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
680:         TaskCore.Review -> ("badge badge-review", "Review")
681:         TaskCore.Approved -> ("badge badge-approved", "Approved")
682:         TaskCore.Done -> ("badge badge-done", "Done")
683:    in Lucid.span_ [Lucid.class_ cls] label
684: 
685: sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
686: sortDropdown basePath currentSort =
687:   Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
688:     Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
689:     Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
690:       Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
691:         <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
692:       Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
693:         sortOption basePath SortNewest currentSort
694:         sortOption basePath SortOldest currentSort
695:         sortOption basePath SortUpdated currentSort
696:         sortOption basePath SortPriorityHigh currentSort
697:         sortOption basePath SortPriorityLow currentSort
698: 
699: sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
700: sortOption basePath option currentSort =
701:   let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
702:       href = basePath <> "?sort=" <> sortOrderToParam option
703:    in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
704: 
705: multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
706: multiColorProgressBar stats =
707:   let total = TaskCore.totalTasks stats
708:       doneCount = TaskCore.doneTasks stats
709:       inProgressCount = TaskCore.inProgressTasks stats
710:       openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
711:       donePct = if total == 0 then 0 else (doneCount * 100) `div` total
712:       inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
713:       openPct = if total == 0 then 0 else (openCount * 100) `div` total
714:    in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
715:         Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
716:           when (donePct > 0)
717:             <| Lucid.div_
718:               [ Lucid.class_ "multi-progress-segment progress-done",
719:                 Lucid.style_ ("width: " <> tshow donePct <> "%"),
720:                 Lucid.title_ (tshow doneCount <> " done")
721:               ]
722:               ""
723:           when (inProgressPct > 0)
724:             <| Lucid.div_
725:               [ Lucid.class_ "multi-progress-segment progress-inprogress",
726:                 Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
727:                 Lucid.title_ (tshow inProgressCount <> " in progress")
728:               ]
729:               ""
730:           when (openPct > 0)
731:             <| Lucid.div_
732:               [ Lucid.class_ "multi-progress-segment progress-open",
733:                 Lucid.style_ ("width: " <> tshow openPct <> "%"),
734:                 Lucid.title_ (tshow openCount <> " open")
735:               ]
736:               ""
737:         Lucid.div_ [Lucid.class_ "progress-legend"] <| do
738:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
739:             Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
740:             Lucid.toHtml ("Done " <> tshow doneCount)
741:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
742:             Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
743:             Lucid.toHtml ("In Progress " <> tshow inProgressCount)
744:           Lucid.span_ [Lucid.class_ "legend-item"] <| do
745:             Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
746:             Lucid.toHtml ("Open " <> tshow openCount)
747: 
748: statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
749: statusBadgeWithForm status tid =
750:   Lucid.div_

636:  ".badge-p0" ? do
1849:    ".badge-p0" ? do
2038:  "Open" -> "badge badge-open"
2039:  "InProgress" -> "badge badge-inprogress"
2040:  "Review" -> "badge badge-review"
2041:  "Approved" -> "badge badge-approved"
2042:  "Done" -> "badge badge-done"
2047:  "P0" -> "badge badge-p0"
2048:  "P1" -> "badge badge-p1"
2049:  "P2" -> "badge badge-p2"
2050:  "P3" -> "badge badge-p3"
2051:  "P4" -> "badge badge-p4"

620:     margin (px 2) (px 0) (px 2) (px 0)
621:     border (px 0) none transparent
622:     cursor pointer
623:     transition "opacity" (ms 150) ease (sec 0)
624:   ".status-dropdown-option" # hover ? do
625:     opacity 0.7
626:   ".status-dropdown-option" # focus ? do
627:     opacity 0.85
628:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
629:     Stylesheet.key "outline-offset" ("1px" :: Text)
630:   ".status-dropdown-option.selected" ? do
631:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
632:     Stylesheet.key "outline-offset" ("1px" :: Text)
633:   ".status-badge-clickable" # focus ? do
634:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
635:     Stylesheet.key "outline-offset" ("2px" :: Text)
636:   ".badge-p0" ? do
637:     backgroundColor "#fee2e2"
638:     color "#991b1b"
639:   ".badge-p1" ? do
640:     backgroundColor "#fef3c7"
641:     color "#92400e"
642:   ".badge-p2" ? do
643:     backgroundColor "#dbeafe"
644:     color "#1e40af"
645:   ".badge-p3" ? do
646:     backgroundColor "#e5e7eb"
647:     color "#4b5563"
648:   ".badge-p4" ? do
649:     backgroundColor "#f3f4f6"
650:     color "#6b7280"
651:   ".priority-badge-dropdown" ? do
652:     position relative
653:     display inlineBlock
654:   ".priority-badge-clickable" ? do
655:     cursor pointer
656:     Stylesheet.key "user-select" ("none" :: Text)
657:   ".priority-badge-clickable" # hover ? do
658:     opacity 0.85
659:   ".priority-dropdown-menu" ? do
660:     display none
661:     position absolute
662:     left (px 0)
663:     top (pct 100)
664:     marginTop (px 2)
665:     backgroundColor white
666:     borderRadius (px 4) (px 4) (px 4) (px 4)
667:     Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
668:     zIndex 100
669:     padding (px 4) (px 4) (px 4) (px 4)
670:     minWidth (px 100)
671:   ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do
672:     display block
673:   ".priority-option-form" ? do
674:     margin (px 0) (px 0) (px 0) (px 0)
675:     padding (px 0) (px 0) (px 0) (px 0)
676:   ".priority-dropdown-option" ? do
677:     display block
678:     width (pct 100)
679:     textAlign (alignSide sideLeft)
680:     margin (px 2) (px 0) (px 2) (px 0)
681:     border (px 0) none transparent
682:     cursor pointer
683:     transition "opacity" (ms 150) ease (sec 0)
684:   ".priority-dropdown-option" # hover ? do
685:     opacity 0.7
686:   ".priority-dropdown-option" # focus ? do
687:     opacity 0.85
688:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
689:     Stylesheet.key "outline-offset" ("1px" :: Text)
690:   ".priority-dropdown-option.selected" ? do
691:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
692:     Stylesheet.key "outline-offset" ("1px" :: Text)
693:   ".priority-badge-clickable" # focus ? do
694:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
695:     Stylesheet.key "outline-offset" ("2px" :: Text)
696: 
697: buttonStyles :: Css
698: buttonStyles = do
699:   ".btn"
700:     <> ".action-btn"

333:  ".stat-card.badge-open" ? do
397:  ".count-badge" ? do
564:statusBadges = do
565:  ".badge" ? do
572:  ".badge-open" ? do
575:  ".badge-inprogress" ? do
578:  ".badge-review" ? do
581:  ".badge-approved" ? do
584:  ".badge-done" ? do
587:  ".status-badge-dropdown" ? do
590:  ".status-badge-clickable" ? do
593:  ".status-badge-clickable" # hover ? do
611:  ".status-badge-dropdown.open" |> ".status-dropdown-menu" ? do
633:  ".status-badge-clickable" # focus ? do
636:  ".badge-p0" ? do
639:  ".badge-p1" ? do
642:  ".badge-p2" ? do
645:  ".badge-p3" ? do
648:  ".badge-p4" ? do
651:  ".priority-badge-dropdown" ? do
654:  ".priority-badge-clickable" ? do
657:  ".priority-badge-clickable" # hover ? do
671:  ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do
693:  ".priority-badge-clickable" # focus ? do
1217:  ".retry-warning-badge" ? do
1834:    ".badge-open" ? do
1837:    ".badge-inprogress" ? do
1840:    ".badge-review" ? do
1843:    ".badge-approved" ? do
1846:    ".badge-done" ? do
1849:    ".badge-p0" ? do
1852:    ".badge-p1" ? do
1855:    ".badge-p2" ? do
1858:    ".badge-p3" ? do
1861:    ".badge-p4" ? do

564: statusBadges = do
565:   ".badge" ? do
566:     display inlineBlock
567:     padding (px 2) (px 6) (px 2) (px 6)
568:     borderRadius (px 2) (px 2) (px 2) (px 2)
569:     fontSize (px 11)
570:     fontWeight (weight 500)
571:     whiteSpace nowrap
572:   ".badge-open" ? do
573:     backgroundColor "#fef3c7"
574:     color "#92400e"
575:   ".badge-inprogress" ? do
576:     backgroundColor "#dbeafe"
577:     color "#1e40af"
578:   ".badge-review" ? do
579:     backgroundColor "#ede9fe"
580:     color "#6b21a8"
581:   ".badge-approved" ? do
582:     backgroundColor "#cffafe"
583:     color "#0e7490"
584:   ".badge-done" ? do
585:     backgroundColor "#d1fae5"
586:     color "#065f46"
587:   ".status-badge-dropdown" ? do
588:     position relative
589:     display inlineBlock
590:   ".status-badge-clickable" ? do

670:           Lucid.a_ [Lucid.href_ "/epics", Lucid.class_ "navbar-dropdown-item"] "Epics"
671:           Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
672:       Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"
673: 
674: statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
675: statusBadge status =
676:   let (cls, label) = case status of
677:         TaskCore.Draft -> ("badge badge-draft", "Draft")
678:         TaskCore.Open -> ("badge badge-open", "Open")
679:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
680:         TaskCore.Review -> ("badge badge-review", "Review")
681:         TaskCore.Approved -> ("badge badge-approved", "Approved")
682:         TaskCore.Done -> ("badge badge-done", "Done")
683:    in Lucid.span_ [Lucid.class_ cls] label
684: 
685: sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
686: sortDropdown basePath currentSort =
687:   Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
688:     Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
689:     Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
690:       Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]

645:   ".badge-p3" ? do
646:     backgroundColor "#e5e7eb"
647:     color "#4b5563"
648:   ".badge-p4" ? do
649:     backgroundColor "#f3f4f6"
650:     color "#6b7280"
651:   ".priority-badge-dropdown" ? do
652:     position relative
653:     display inlineBlock
654:   ".priority-badge-clickable" ? do
655:     cursor pointer
656:     Stylesheet.key "user-select" ("none" :: Text)
657:   ".priority-badge-clickable" # hover ? do
658:     opacity 0.85
659:   ".priority-dropdown-menu" ? do
660:     display none
661:     position absolute
662:     left (px 0)
663:     top (pct 100)
664:     marginTop (px 2)
665:     backgroundColor white
666:     borderRadius (px 4) (px 4) (px 4) (px 4)
667:     Stylesheet.key "box-shadow" ("0 2px 8px rgba(0,0,0,0.15)" :: Text)
668:     zIndex 100
669:     padding (px 4) (px 4) (px 4) (px 4)
670:     minWidth (px 100)
671:   ".priority-badge-dropdown.open" |> ".priority-dropdown-menu" ? do
672:     display block
673:   ".priority-option-form" ? do
674:     margin (px 0) (px 0) (px 0) (px 0)
675:     padding (px 0) (px 0) (px 0) (px 0)
676:   ".priority-dropdown-option" ? do
677:     display block
678:     width (pct 100)
679:     textAlign (alignSide sideLeft)
680:     margin (px 2) (px 0) (px 2) (px 0)
681:     border (px 0) none transparent
682:     cursor pointer
683:     transition "opacity" (ms 150) ease (sec 0)
684:   ".priority-dropdown-option" # hover ? do
685:     opacity 0.7
686:   ".priority-dropdown-option" # focus ? do
687:     opacity 0.85
688:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
689:     Stylesheet.key "outline-offset" ("1px" :: Text)
690:   ".priority-dropdown-option.selected" ? do
691:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
692:     Stylesheet.key "outline-offset" ("1px" :: Text)
693:   ".priority-badge-clickable" # focus ? do
694:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
695:     Stylesheet.key "outline-offset" ("2px" :: Text)
696: 
697: buttonStyles :: Css
698: buttonStyles = do
699:   ".btn"
700:     <> ".action-btn"

7[10000;10000Hthese 4 derivations will be built:
  /nix/store/nfzfcn6r842czgwbjanpqzkdksphxwnm-hs-mod-Omni_Jr_Web_Style.drv
  /nix/store/5isn119k3rm2ppd63khm1jp0y2a50w3q-hs-mod-Omni_Jr_Web.drv
  /nix/store/9vx94qz8rac569irk0w55hspgacjcqjd-hs-mod-Omni_Jr.drv
  /nix/store/rbhjsg2gn8xlgmrdy8vnim99kdxrb423-jr.drv
building '/nix/store/nfzfcn6r842czgwbjanpqzkdksphxwnm-hs-mod-Omni_Jr_Web_Style.drv'...
building '/nix/store/5isn119k3rm2ppd63khm1jp0y2a50w3q-hs-mod-Omni_Jr_Web.drv'...

Omni/Jr/Web.hs:689:7: error: [GHC-18872]
    * Couldn't match type `Text' with `Lucid.HtmlT m ()'
        arising from a use of `Lucid.span_'
    * In the expression:
        Lucid.span_
          [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
      In the expression:
        let
          cls
            = "badge badge-complexity badge-complexity-" <> tshow complexity
          label = "? " <> tshow complexity
        in
          Lucid.span_
            [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
      In an equation for `complexityBadge':
          complexityBadge complexity
            = let
                cls
                  = "badge badge-complexity badge-complexity-" <> tshow complexity
                label = "? " <> tshow complexity
              in
                Lucid.span_
                  [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
    * Relevant bindings include
        complexityBadge :: Int -> Lucid.HtmlT m ()
          (bound at Omni/Jr/Web.hs:686:1)
    |
689 |    in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
    |       ^^^^^^^^^^^
error: builder for '/nix/store/5isn119k3rm2ppd63khm1jp0y2a50w3q-hs-mod-Omni_Jr_Web.drv' failed with exit code 1;
       last 25 log lines:
       >         Lucid.span_
       >           [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
       >       In the expression:
       >         let
       >           cls
       >             = "badge badge-complexity badge-complexity-" <> tshow complexity
       >           label = "? " <> tshow complexity
       >         in
       >           Lucid.span_
       >             [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
       >       In an equation for `complexityBadge':
       >           complexityBadge complexity
       >             = let
       >                 cls
       >                   = "badge badge-complexity badge-complexity-" <> tshow complexity
       >                 label = "? " <> tshow complexity
       >               in
       >                 Lucid.span_
       >                   [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
       >     * Relevant bindings include
       >         complexityBadge :: Int -> Lucid.HtmlT m ()
       >           (bound at Omni/Jr/Web.hs:686:1)
       >     |
       > 689 |    in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] label
       >     |       ^^^^^^^^^^^
       For full logs, run 'nix-store -l /nix/store/5isn119k3rm2ppd63khm1jp0y2a50w3q-hs-mod-Omni_Jr_Web.drv'.
error: 1 dependencies of derivation '/nix/store/rbhjsg2gn8xlgmrdy8vnim99kdxrb423-jr.drv' failed to build

[1A[1G[2K[.] Omni/Jr.hs
[1A[1G[2K[0m[+] Omni/Jr.hs[0m[1B[1A[1G[2K[0m[~] Omni/Jr.hs[0m[1B[1A[1G[2K[~] Omni/Jr.hs: warning: you did not specify '--add-root'; the result might ...[1B[1A[1G[2K[~] Omni/Jr.hs: /nix/store/rbhjsg2gn8xlgmrdy8vnim99kdxrb423-jr.drv...[1B[1A[1G[2K[~] Omni/Jr.hs: these 4 derivations will be built:...[1B[1A[1G[2K[~] Omni/Jr.hs:   /nix/store/nfzfcn6r842czgwbjanpqzkdksphxwnm-hs-mod-Omni_Jr...[1B[1A[1G[2K[~] Omni/Jr.hs: building '/nix/store/nfzfcn6r842czgwbjanpqzkdksphxwnm-hs-mod...[1B[1A[1G[2K[~] Omni/Jr.hs: building '/nix/store/5isn119k3rm2ppd63khm1jp0y2a50w3q-hs-mod...[1B[1A[1G[2K[~] Omni/Jr.hs: ...[1B[1A[1G[2K[~] Omni/Jr.hs: Omni/Jr/Web.hs:689:7: error: [GHC-18872]    * Couldn't match...[1B[1A[1G[2K[~] Omni/Jr.hs:     * In the expression:        Lucid.span_          [Lucid....[1B[1A[1G[2K[~] Omni/Jr.hs:                 label = "? " <> tshow complexity            ...[1B[1A[1G[2K[~] Omni/Jr.hs: error: builder for '/nix/store/5isn119k3rm2ppd63khm1jp0y2a50...[1B[1A[1G[2K[~] Omni/Jr.hs: error: 1 dependencies of derivation '/nix/store/rbhjsg2gn8xl...[1B[0m[38;5;1m[2Kfail:  bild:  realise:  Omni/Jr.hs
[0m[0m
[0m[1A[1G[2K[0m[38;5;1m[x] Omni/Jr.hs[0m[1B1

1524:                 Lucid.div_ [Lucid.class_ "task-meta"] <| do
1525:                   Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
1526:                     Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
1527:                     metaSep
1528:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
1529:                     metaSep
1530:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
1531:                     metaSep
1532:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
1533:                     case TaskCore.taskComplexity task of
1534:                       Nothing -> pure ()
1535:                       Just c -> do

693:   ".priority-badge-clickable" # focus ? do
694:     Stylesheet.key "outline" ("2px solid #0066cc" :: Text)
695:     Stylesheet.key "outline-offset" ("2px" :: Text)
696:   ".badge-complexity" ? do
697:     backgroundColor "#f0f9ff"
698:     color "#0c4a6e"
699:   ".badge-complexity-1" ? do
700:     backgroundColor "#f0fdf4"
701:     color "#166534"
702:   ".badge-complexity-2" ? do
703:     backgroundColor "#f0f9ff"
704:     color "#075985"
705:   ".badge-complexity-3" ? do
706:     backgroundColor "#fef3c7"
707:     color "#92400e"
708:   ".badge-complexity-4" ? do
709:     backgroundColor "#fef3c7"
710:     color "#b45309"
711:   ".badge-complexity-5" ? do
712:     backgroundColor "#fee2e2"
713:     color "#991b1b"
714: 
715: buttonStyles :: Css

{-# LANGUAGE OverloadedStrings #-}
import qualified Lucid
import qualified Data.Text as Text

-- Simulate the complexity badge function
complexityBadge :: (Monad m) => Int -> Lucid.HtmlT m ()
complexityBadge complexity =
  let cls = "badge badge-complexity badge-complexity-" <> Text.pack (show complexity)
      label = "ℂ " <> Text.pack (show complexity)
   in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] (Lucid.toHtml label)

main :: IO ()
main = do
  putStrLn "Testing complexity badges:"
  mapM_ (\c -> do
    putStrLn $ "Complexity " ++ show c ++ ":"
    putStrLn $ "  " ++ show (Lucid.renderText (complexityBadge c))
    ) [1..5]