Fix agent event content double-encoding in web UI

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

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

./Omni/Task.hs:479:  let lastEventId = if null events then 0 else maximum (map storedEventId events)
./Omni/Task.hs:498:      let newLastId = if null newEvents then lastId else maximum (map storedEventId newEvents)
./Omni/Task.hs:502:printEvent :: StoredEvent -> IO ()
./Omni/Task.hs:504:  let timestamp = storedEventTimestamp event
./Omni/Task.hs:505:      eventType = storedEventType event
./Omni/Task.hs:506:      content = storedEventContent event
./Omni/Jr/Web.hs:278:  = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) [TaskCore.StoredEvent] UTCTime
./Omni/Jr/Web.hs:347:data AgentEventsPartial = AgentEventsPartial [TaskCore.StoredEvent] Bool UTCTime
./Omni/Jr/Web.hs:2416:renderAgentLogSection :: (Monad m) => Text -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:2442:renderAgentEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
./Omni/Jr/Web.hs:2444:  let eventType = TaskCore.storedEventType event
./Omni/Jr/Web.hs:2445:      content = TaskCore.storedEventContent event
./Omni/Jr/Web.hs:2446:      timestamp = TaskCore.storedEventTimestamp event
./Omni/Jr/Web.hs:2447:      eventId = TaskCore.storedEventId event
./Omni/Jr/Web.hs:2579:  let lastId = if null existingEvents then 0 else maximum (map TaskCore.storedEventId existingEvents)
./Omni/Jr/Web.hs:2614:              let newLastId = maximum (map TaskCore.storedEventId newEvents)
./Omni/Jr/Web.hs:2620:-- | Convert a StoredEvent to SSE format
./Omni/Jr/Web.hs:2621:eventToSSE :: TaskCore.StoredEvent -> ByteString
./Omni/Jr/Web.hs:2623:  let eventType = Text.toLower (TaskCore.storedEventType event)
./Omni/Jr/Web.hs:2624:      content = TaskCore.storedEventContent event
./Omni/Task/Core.hs:1613:data StoredEvent = StoredEvent
./Omni/Task/Core.hs:1614:  { storedEventId :: Int,
./Omni/Task/Core.hs:1615:    storedEventTaskId :: Text,
./Omni/Task/Core.hs:1616:    storedEventSessionId :: Text,
./Omni/Task/Core.hs:1617:    storedEventTimestamp :: UTCTime,
./Omni/Task/Core.hs:1618:    storedEventType :: Text,
./Omni/Task/Core.hs:1619:    storedEventContent :: Text
./Omni/Task/Core.hs:1623:instance ToJSON StoredEvent
./Omni/Task/Core.hs:1625:instance FromJSON StoredEvent
./Omni/Task/Core.hs:1627:instance SQL.FromRow StoredEvent where
./Omni/Task/Core.hs:1629:    StoredEvent
./Omni/Task/Core.hs:1653:getEventsForTask :: Text -> IO [StoredEvent]
./Omni/Task/Core.hs:1661:getEventsForSession :: Text -> IO [StoredEvent]
./Omni/Task/Core.hs:1697:getEventsSince :: Text -> Int -> IO [StoredEvent]

1650:       (taskId, sessionId, eventType, content)
1651: 
1652: -- | Get all events for a task (most recent session)
1653: getEventsForTask :: Text -> IO [StoredEvent]
1654: getEventsForTask taskId = do
1655:   maybeSession <- getLatestSessionForTask taskId
1656:   case maybeSession of
1657:     Nothing -> pure []
1658:     Just sid -> getEventsForSession sid
1659: 
1660: -- | Get all events for a specific session
1661: getEventsForSession :: Text -> IO [StoredEvent]
1662: getEventsForSession sessionId =
1663:   withDb <| \conn ->
1664:     SQL.query
1665:       conn
1666:       "SELECT id, task_id, session_id, timestamp, event_type, content \
1667:       \FROM agent_events WHERE session_id = ? ORDER BY id ASC"
1668:       (SQL.Only sessionId)
1669: 
1670: -- | Get all sessions for a task
1671: getSessionsForTask :: Text -> IO [Text]
1672: getSessionsForTask taskId =
1673:   withDb <| \conn -> do
1674:     rows <-
1675:       SQL.query
1676:         conn
1677:         "SELECT DISTINCT session_id FROM agent_events WHERE task_id = ? ORDER BY session_id DESC"
1678:         (SQL.Only taskId) ::
1679:         IO [SQL.Only Text]
1680:     pure [sid | SQL.Only sid <- rows]
1681: 
1682: -- | Get the most recent session ID for a task
1683: getLatestSessionForTask :: Text -> IO (Maybe Text)
1684: getLatestSessionForTask taskId =
1685:   withDb <| \conn -> do
1686:     rows <-
1687:       SQL.query
1688:         conn
1689:         "SELECT session_id FROM agent_events WHERE task_id = ? ORDER BY id DESC LIMIT 1"
1690:         (SQL.Only taskId) ::
1691:         IO [SQL.Only Text]
1692:     pure <| case rows of
1693:       [SQL.Only sid] -> Just sid
1694:       _ -> Nothing
1695: 
1696: -- | Get events for a task since a given event ID (for streaming/polling)
1697: getEventsSince :: Text -> Int -> IO [StoredEvent]
1698: getEventsSince sessionId lastId =
1699:   withDb <| \conn ->
1700:     SQL.query
1701:       conn
1702:       "SELECT id, task_id, session_id, timestamp, event_type, content \
1703:       \FROM agent_events WHERE session_id = ? AND id > ? ORDER BY id ASC"
1704:       (sessionId, lastId)

1635:       <*> SQL.field
1636: 
1637: -- | Generate a new session ID (timestamp-based for simplicity)
1638: generateSessionId :: IO Text
1639: generateSessionId = do
1640:   now <- getCurrentTime
1641:   pure <| "s-" <> T.pack (show now)
1642: 
1643: -- | Insert an agent event
1644: insertAgentEvent :: Text -> Text -> Text -> Text -> IO ()
1645: insertAgentEvent taskId sessionId eventType content =
1646:   withDb <| \conn ->
1647:     SQL.execute
1648:       conn
1649:       "INSERT INTO agent_events (task_id, session_id, event_type, content) VALUES (?, ?, ?, ?)"
1650:       (taskId, sessionId, eventType, content)
1651: 
1652: -- | Get all events for a task (most recent session)
1653: getEventsForTask :: Text -> IO [StoredEvent]
1654: getEventsForTask taskId = do
1655:   maybeSession <- getLatestSessionForTask taskId
1656:   case maybeSession of
1657:     Nothing -> pure []
1658:     Just sid -> getEventsForSession sid
1659: 
1660: -- | Get all events for a specific session

240:       -- Build user prompt from task comments
241:       let userPrompt = formatTask task
242: 
243:       -- Select model based on task complexity (simple heuristic)
244:       let model = selectModel task
245: 
246:       -- Generate session ID for event logging
247:       sessionId <- TaskCore.generateSessionId
248:       let tid = TaskCore.taskId task
249: 
250:       -- Helper to log events to DB
251:       -- For text content, store as-is; for structured data, JSON-encode
252:       let logEventText = TaskCore.insertAgentEvent tid sessionId
253:           logEventJson eventType value = do
254:             let contentJson = TE.decodeUtf8 (BSL.toStrict (Aeson.encode value))
255:             TaskCore.insertAgentEvent tid sessionId eventType contentJson
256: 
257:       -- Build Engine config with callbacks
258:       totalCostRef <- newIORef (0 :: Double)
259:       let quiet = Core.workerQuiet worker
260:           sayLog msg = if quiet then putText msg else AgentLog.log msg
261:           engineCfg =
262:             Engine.EngineConfig
263:               { Engine.engineLLM =
264:                   Engine.defaultLLM
265:                     { Engine.llmApiKey = Text.pack apiKey
266:                     },
267:                 Engine.engineOnCost = \tokens cost -> do
268:                   modifyIORef' totalCostRef (+ cost)
269:                   sayLog <| "Cost: " <> tshow cost <> " cents (" <> tshow tokens <> " tokens)"
270:                   logEventJson "Cost" (Aeson.object [("tokens", Aeson.toJSON tokens), ("cents", Aeson.toJSON cost)]),
271:                 Engine.engineOnActivity = \activity -> do
272:                   sayLog <| "[engine] " <> activity,
273:                 Engine.engineOnToolCall = \toolName args -> do
274:                   sayLog <| "[tool] " <> toolName
275:                   logEventText "ToolCall" (toolName <> ": " <> args),
276:                 Engine.engineOnAssistant = \msg -> do
277:                   sayLog <| "[assistant] " <> Text.take 200 msg
278:                   logEventText "Assistant" msg,
279:                 Engine.engineOnToolResult = \toolName success output -> do
280:                   let statusStr = if success then "ok" else "failed"

280:                   let statusStr = if success then "ok" else "failed"
281:                   sayLog <| "[result] " <> toolName <> " (" <> statusStr <> "): " <> Text.take 100 output
282:                   logEventText "ToolResult" output,
283:                 Engine.engineOnComplete = do
284:                   sayLog "[engine] Complete"
285:                   logEventText "Complete" "",
286:                 Engine.engineOnError = \err -> do
287:                   sayLog <| "[error] " <> err
288:                   logEventText "Error" err
289:               }
290: 
291:       -- Build Agent config
292:       let agentCfg =
293:             Engine.AgentConfig
294:               { Engine.agentModel = model,
295:                 Engine.agentTools = Tools.allTools,
296:                 Engine.agentSystemPrompt = systemPrompt,
297:                 Engine.agentMaxIterations = 100
298:               }
299: 
300:       -- Run the agent
301:       result <- Engine.runAgent engineCfg agentCfg userPrompt
302:       totalCost <- readIORef totalCostRef
303: 
304:       case result of
305:         Left err -> pure (Exit.ExitFailure 1, "Engine error: " <> err, totalCost)
306:         Right agentResult -> do
307:           let output = Engine.resultFinalMessage agentResult
308:           pure (Exit.ExitSuccess, output, totalCost)
309: 
310: -- | Build the base prompt for the agent

585:       engineOnActivity engineCfg <| "Executing tool: " <> name
586:       engineOnToolCall engineCfg name argsText
587:       case Map.lookup name toolMap of
588:         Nothing -> do
589:           let errMsg = "Tool not found: " <> name
590:           engineOnToolResult engineCfg name False errMsg
591:           pure <| Message ToolRole errMsg Nothing (Just callId)
592:         Just tool -> do
593:           case Aeson.decode (BL.fromStrict (TE.encodeUtf8 argsText)) of
594:             Nothing -> do
595:               let errMsg = "Invalid JSON arguments: " <> argsText
596:               engineOnToolResult engineCfg name False errMsg
597:               pure <| Message ToolRole errMsg Nothing (Just callId)
598:             Just args -> do
599:               resultValue <- toolExecute tool args
600:               let resultText = TE.decodeUtf8 (BL.toStrict (Aeson.encode resultValue))
601:               engineOnToolResult engineCfg name True resultText
602:               pure <| Message ToolRole resultText Nothing (Just callId)
603: 
604: -- | Estimate cost in cents from token count
605: estimateCost :: Text -> Int -> Double
606: estimateCost model tokens
607:   | "gpt-4o-mini" `Text.isInfixOf` model = fromIntegral tokens * 15 / 1000000
608:   | "gpt-4o" `Text.isInfixOf` model = fromIntegral tokens * 250 / 100000
609:   | "gpt-4" `Text.isInfixOf` model = fromIntegral tokens * 3 / 100000
610:   | "claude" `Text.isInfixOf` model = fromIntegral tokens * 3 / 100000

2462: renderAssistantEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2463: renderAssistantEvent content timestamp now =
2464:   Lucid.div_ [Lucid.class_ "event-assistant"] <| do
2465:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2466:       Lucid.span_ [Lucid.class_ "event-icon"] "💬"
2467:       Lucid.span_ [Lucid.class_ "event-label"] "Assistant"
2468:       renderRelativeTimestamp now timestamp
2469:     Lucid.div_ [Lucid.class_ "event-content event-bubble"] <| do
2470:       let truncated = Text.take 2000 content
2471:           isTruncated = Text.length content > 2000
2472:       Lucid.toHtml truncated
2473:       when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
2474: 
2475: renderToolCallEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()

2462: renderAssistantEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2463: renderAssistantEvent content timestamp now =
2464:   Lucid.div_ [Lucid.class_ "event-assistant"] <| do
2465:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2466:       Lucid.span_ [Lucid.class_ "event-icon"] "💬"
2467:       Lucid.span_ [Lucid.class_ "event-label"] "Assistant"
2468:       renderRelativeTimestamp now timestamp
2469:     Lucid.div_ [Lucid.class_ "event-content event-bubble"] <| do
2470:       let truncated = Text.take 2000 content
2471:           isTruncated = Text.length content > 2000
2472:       Lucid.toHtml truncated
2473:       when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
2474: 

2540:             Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
2541:         else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
2542: 
2543: agentLogScrollScript :: (Monad m) => Lucid.HtmlT m ()
2544: agentLogScrollScript =
2545:   Lucid.script_
2546:     [ Lucid.type_ "text/javascript"
2547:     ]
2548:     ( Text.unlines
2549:         [ "(function() {",
2550:           "  var log = document.querySelector('.agent-log');",
2551:           "  if (log) {",
2552:           "    var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",
2553:           "    if (isNearBottom) {",
2554:           "      log.scrollTop = log.scrollHeight;",
2555:           "    }",
2556:           "  }",
2557:           "})();"
2558:         ]
2559:     )
2560: 

agentLogScrollScript :: (Monad m) => Lucid.HtmlT m ()$
agentLogScrollScript =$
  Lucid.script_$
    [ Lucid.type_ "text/javascript"$
    ]$
    ( Text.unlines$
        [ "(function() {",$
          "  var log = document.querySelector('.agent-log');",$
          "  if (log) {",$
          "    var isNearBottom = log.scrollHeight - log.scrollTop - log.clientHeight < 100;",$
          "    if (isNearBottom) {",$
          "      log.scrollTop = log.scrollHeight;",$
          "    }",$
          "  }",$
          "})();"$
        ]$
    )$

renderCollapsibleOutput :: (Monad m) => Text -> Lucid.HtmlT m ()
renderCollapsibleOutput content =
  let lineCount = length (Text.lines content)
   in if lineCount > 20
        then
          Lucid.details_ [Lucid.class_ "output-collapsible"] <| do
            Lucid.summary_ (Lucid.toHtml (tshow lineCount <> " lines"))
            Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)
        else Lucid.pre_ [Lucid.class_ "tool-output-pre"] (Lucid.toHtml content)

agentLogScrollScript :: (Monad m) => Lucid.HtmlT m ()

-- | Render text with literal \n replaced by <br> tags
renderTextWithNewlines :: (Monad m) => Text -> Lucid.HtmlT m ()
renderTextWithNewlines txt =
  let parts = Text.splitOn "\\n" txt
   in traverse_ renderPart (zip [0 ..] parts)
  where
    renderPart (idx, part) = do
      Lucid.toHtml part
      when (idx < length parts - 1) <| Lucid.br_ []

-- | Decode JSON tool result and render in a user-friendly way
renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
renderDecodedToolResult content =
  case Aeson.decode (LBS.fromStrict (str content)) of
    Just (obj :: Aeson.Object) ->
      case Aeson.lookup "output" obj of
        Just (Aeson.String output) -> Lucid.toHtml output
        _ -> Lucid.toHtml content -- Fallback to raw if no output field
    Nothing -> Lucid.toHtml content -- Fallback to raw if not JSON

2462: renderAssistantEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2463: renderAssistantEvent content timestamp now =
2464:   Lucid.div_ [Lucid.class_ "event-assistant"] <| do
2465:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2466:       Lucid.span_ [Lucid.class_ "event-icon"] "💬"
2467:       Lucid.span_ [Lucid.class_ "event-label"] "Assistant"
2468:       renderRelativeTimestamp now timestamp
2469:     Lucid.div_ [Lucid.class_ "event-content event-bubble"] <| do
2470:       let truncated = Text.take 2000 content
2471:           isTruncated = Text.length content > 2000
2472:       Lucid.toHtml truncated
2473:       when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."
2474: 

2506:   Lucid.div_ [Lucid.class_ "event-cost"] <| do
2507:     Lucid.span_ [Lucid.class_ "event-icon"] "💰"
2508:     Lucid.span_ [Lucid.class_ "cost-text"] (Lucid.toHtml content)
2509: 
2510: renderErrorEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2511: renderErrorEvent content timestamp now =
2512:   Lucid.div_ [Lucid.class_ "event-error"] <| do
2513:     Lucid.div_ [Lucid.class_ "event-header"] <| do
2514:       Lucid.span_ [Lucid.class_ "event-icon"] "❌"
2515:       Lucid.span_ [Lucid.class_ "event-label"] "Error"
2516:       renderRelativeTimestamp now timestamp
2517:     Lucid.div_ [Lucid.class_ "event-content error-message"] (Lucid.toHtml content)
2518: 
2519: renderCompleteEvent :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
2520: renderCompleteEvent timestamp now =
2521:   Lucid.div_ [Lucid.class_ "event-complete"] <| do
2522:     Lucid.span_ [Lucid.class_ "event-icon"] "✅"

2486: renderToolResultEvent :: (Monad m) => Text -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
2487: renderToolResultEvent content timestamp now =
2488:   let lineCount = length (Text.lines content)
2489:       isLong = lineCount > 20
2490:    in Lucid.div_ [Lucid.class_ "event-tool-result"] <| do
2491:         Lucid.div_ [Lucid.class_ "event-header result-header"] <| do
2492:           Lucid.span_ [Lucid.class_ "event-icon"] "📋"
2493:           Lucid.span_ [Lucid.class_ "event-label"] "Result"
2494:           when (lineCount > 1)
2495:             <| Lucid.span_ [Lucid.class_ "line-count"] (Lucid.toHtml (tshow lineCount <> " lines"))
2496:           renderRelativeTimestamp now timestamp
2497:         if isLong
2498:           then
2499:             Lucid.details_ [Lucid.class_ "result-collapsible"] <| do
2500:               Lucid.summary_ "Show output"
2501:               Lucid.pre_ [Lucid.class_ "event-content tool-output"] (Lucid.toHtml content)
2502:           else Lucid.pre_ [Lucid.class_ "event-content tool-output"] (Lucid.toHtml content)
2503: 
2504: renderCostEvent :: (Monad m) => Text -> Lucid.HtmlT m ()
2505: renderCostEvent content =

2543: 
2544: -- | Render text with literal \n replaced by <br> tags
2545: renderTextWithNewlines :: (Monad m) => Text -> Lucid.HtmlT m ()
2546: renderTextWithNewlines txt =
2547:   let parts = Text.splitOn "\\n" txt
2548:    in traverse_ renderPart (zip [0 ..] parts)
2549:   where
2550:     renderPart (idx, part) = do
2551:       Lucid.toHtml part
2552:       when (idx < length parts - 1) <| Lucid.br_ []
2553: 
2554: -- | Decode JSON tool result and render in a user-friendly way
2555: renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
2556: renderDecodedToolResult content =
2557:   case Aeson.decode (LBS.fromStrict (str content)) of
2558:     Just (obj :: Aeson.Object) ->
2559:       case Aeson.lookup "output" obj of
2560:         Just (Aeson.String output) -> Lucid.toHtml output
2561:         _ -> Lucid.toHtml content -- Fallback to raw if no output field
2562:     Nothing -> Lucid.toHtml content -- Fallback to raw if not JSON
2563: 

21:import qualified Data.Aeson as Aeson
2557:  case Aeson.decode (LBS.fromStrict (str content)) of
2558:    Just (obj :: Aeson.Object) ->
2559:      case Aeson.lookup "output" obj of
2560:        Just (Aeson.String output) -> Lucid.toHtml output
2647:        "assistant" -> Aeson.object ["content" Aeson..= content]
2650:           in Aeson.object ["tool" Aeson..= tool, "args" Aeson..= Aeson.object ["data" Aeson..= args]]
2652:          Aeson.object ["tool" Aeson..= ("unknown" :: Text), "success" Aeson..= True, "output" Aeson..= content]
2653:        "cost" -> Aeson.object ["cost" Aeson..= content]
2654:        "error" -> Aeson.object ["error" Aeson..= content]
2655:        "complete" -> Aeson.object []
2656:        _ -> Aeson.object ["content" Aeson..= content]
2657:   in formatSSE eventType (str (Aeson.encode jsonData))

2544: 
2545: -- | Render text with literal \n replaced by <br> tags
2546: renderTextWithNewlines :: (Monad m) => Text -> Lucid.HtmlT m ()
2547: renderTextWithNewlines txt =
2548:   let parts = Text.splitOn "\\n" txt
2549:    in traverse_ renderPart (zip [0 ..] parts)
2550:   where
2551:     renderPart (idx, part) = do
2552:       Lucid.toHtml part
2553:       when (idx < length parts - 1) <| Lucid.br_ []
2554: 
2555: -- | Decode JSON tool result and render in a user-friendly way
2556: renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
2557: renderDecodedToolResult content =
2558:   case Aeson.decode (LBS.fromStrict (str content)) of
2559:     Just (Aeson.Object obj) ->
2560:       case KeyMap.lookup "output" obj of
2561:         Just (Aeson.String output) -> Lucid.toHtml output
2562:         _ -> Lucid.toHtml content -- Fallback to raw if no output field
2563:     _ -> Lucid.toHtml content -- Fallback to raw if not JSON