path: root/Omni/Jr/Web/Components.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : dep lucid
-- : dep servant-lucid
module Omni.Jr.Web.Components
  ( -- * Time formatting
    formatRelativeTime,
    relativeText,
    formatExactTimestamp,
    renderRelativeTimestamp,

    -- * Small components
    metaSep,

    -- * Page layout
    pageHead,
    pageBody,
    pageBodyWithCrumbs,
    navbar,

    -- * JavaScript
    navbarDropdownJs,
    statusDropdownJs,
    priorityDropdownJs,
    liveToggleJs,

    -- * Breadcrumbs
    Breadcrumb (..),
    Breadcrumbs,
    renderBreadcrumbs,
    getAncestors,
    taskBreadcrumbs,

    -- * Badges
    statusBadge,
    complexityBadge,
    statusBadgeWithForm,
    clickableBadge,
    statusDropdownOptions,
    statusOption,
    priorityBadgeWithForm,
    clickablePriorityBadge,
    priorityDropdownOptions,
    priorityOption,

    -- * Sorting
    SortOrder (..),
    sortOrderToParam,
    sortOrderLabel,
    sortDropdown,
    sortOption,

    -- * Progress bars
    multiColorProgressBar,
    epicProgressBar,

    -- * Task rendering
    renderTaskCard,
    renderBlockedTaskCard,
    renderListGroupItem,
    renderEpicReviewCard,
    renderEpicCardWithStats,
    getDescendants,

    -- * Metrics
    renderAggregatedMetrics,

    -- * Retry context
    renderRetryContextBanner,

    -- * Markdown
    MarkdownBlock (..),
    InlinePart (..),
    renderMarkdown,
    parseBlocks,
    renderBlocks,
    renderBlock,
    renderListItem,
    renderInline,
    parseInline,
    parseBold,
    renderInlineParts,
    renderInlinePart,

    -- * Comments
    commentForm,

    -- * Live toggles
    renderLiveToggle,
    renderAutoscrollToggle,

    -- * Cost/Token metrics
    aggregateCostMetrics,
    formatCostHeader,
    formatTokensHeader,

    -- * Timeline
    renderUnifiedTimeline,
    renderTimelineEvent,
    eventTypeIconAndLabel,
    renderActorLabel,
    renderCommentTimelineEvent,
    renderStatusChangeEvent,
    parseStatusChange,
    renderActivityEvent,
    renderErrorTimelineEvent,
    renderAssistantTimelineEvent,
    renderToolCallTimelineEvent,
    renderToolResultTimelineEvent,
    renderCheckpointEvent,
    renderGuardrailEvent,
    renderGenericEvent,
    parseToolCallContent,
    formatToolCallSummary,
    renderCollapsibleOutput,
    renderDecodedToolResult,
    timelineScrollScript,
  )
where

import Alpha
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as List
import qualified Data.Text as Text
import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime)
import qualified Lucid
import qualified Lucid.Base as Lucid
import Numeric (showFFloat)
import qualified Omni.Task.Core as TaskCore

-- * Time formatting

formatRelativeTime :: UTCTime -> UTCTime -> Text
formatRelativeTime now timestamp =
  let delta = diffUTCTime now timestamp
   in relativeText delta

relativeText :: NominalDiffTime -> Text
relativeText delta
  | delta < 60 = "just now"
  | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago"
  | delta < 7200 = "1 hour ago"
  | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago"
  | delta < 172800 = "yesterday"
  | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago"
  | delta < 1209600 = "1 week ago"
  | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago"
  | delta < 5184000 = "1 month ago"
  | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago"
  | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago"

formatExactTimestamp :: UTCTime -> Text
formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC"

renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderRelativeTimestamp now timestamp =
  Lucid.span_
    [ Lucid.class_ "relative-time",
      Lucid.title_ (formatExactTimestamp timestamp)
    ]
    (Lucid.toHtml (formatRelativeTime now timestamp))

-- * Small components

metaSep :: (Monad m) => Lucid.HtmlT m ()
metaSep = Lucid.span_ [Lucid.class_ "meta-sep"] "·"

-- * Sort types

data SortOrder
  = SortNewest
  | SortOldest
  | SortUpdated
  | SortPriorityHigh
  | SortPriorityLow
  deriving (Show, Eq)

sortOrderToParam :: SortOrder -> Text
sortOrderToParam SortNewest = "newest"
sortOrderToParam SortOldest = "oldest"
sortOrderToParam SortUpdated = "updated"
sortOrderToParam SortPriorityHigh = "priority-high"
sortOrderToParam SortPriorityLow = "priority-low"

sortOrderLabel :: SortOrder -> Text
sortOrderLabel SortNewest = "Newest First"
sortOrderLabel SortOldest = "Oldest First"
sortOrderLabel SortUpdated = "Recently Updated"
sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
sortOrderLabel SortPriorityLow = "Priority (Low to High)"

-- * Page layout

pageHead :: (Monad m) => Text -> Lucid.HtmlT m ()
pageHead title =
  Lucid.head_ <| do
    Lucid.title_ (Lucid.toHtml title)
    Lucid.meta_ [Lucid.charset_ "utf-8"]
    Lucid.meta_
      [ Lucid.name_ "viewport",
        Lucid.content_ "width=device-width, initial-scale=1"
      ]
    Lucid.link_ [Lucid.rel_ "stylesheet", Lucid.href_ "/style.css"]
    Lucid.script_
      [ Lucid.src_ "https://unpkg.com/htmx.org@2.0.4",
        Lucid.integrity_ "sha384-HGfztofotfshcF7+8n44JQL2oJmowVChPTg48S+jvZoztPfvwD79OC/LTtG6dMp+",
        Lucid.crossorigin_ "anonymous"
      ]
      ("" :: Text)
    Lucid.script_ [] statusDropdownJs
    Lucid.script_ [] priorityDropdownJs
    Lucid.script_ [] navbarDropdownJs
    Lucid.script_ [] liveToggleJs

-- * JavaScript

navbarDropdownJs :: Text
navbarDropdownJs =
  Text.unlines
    [ "document.addEventListener('DOMContentLoaded', function() {",
      "  document.querySelectorAll('.navbar-dropdown-btn').forEach(function(btn) {",
      "    btn.addEventListener('click', function(e) {",
      "      e.preventDefault();",
      "      var dropdown = btn.closest('.navbar-dropdown');",
      "      var isOpen = dropdown.classList.contains('open');",
      "      document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
      "        d.classList.remove('open');",
      "      });",
      "      if (!isOpen) {",
      "        dropdown.classList.add('open');",
      "      }",
      "    });",
      "  });",
      "  document.addEventListener('click', function(e) {",
      "    if (!e.target.closest('.navbar-dropdown')) {",
      "      document.querySelectorAll('.navbar-dropdown.open').forEach(function(d) {",
      "        d.classList.remove('open');",
      "      });",
      "    }",
      "  });",
      "});"
    ]

statusDropdownJs :: Text
statusDropdownJs =
  Text.unlines
    [ "function toggleStatusDropdown(el) {",
      "  var container = el.parentElement;",
      "  var isOpen = container.classList.toggle('open');",
      "  el.setAttribute('aria-expanded', isOpen);",
      "  if (isOpen) {",
      "    var firstItem = container.querySelector('[role=\"menuitem\"]');",
      "    if (firstItem) firstItem.focus();",
      "  }",
      "}",
      "",
      "function closeStatusDropdown(container) {",
      "  container.classList.remove('open');",
      "  var badge = container.querySelector('[role=\"button\"]');",
      "  if (badge) {",
      "    badge.setAttribute('aria-expanded', 'false');",
      "    badge.focus();",
      "  }",
      "}",
      "",
      "function handleStatusKeydown(event, el) {",
      "  if (event.key === 'Enter' || event.key === ' ') {",
      "    event.preventDefault();",
      "    toggleStatusDropdown(el);",
      "  } else if (event.key === 'Escape') {",
      "    closeStatusDropdown(el.parentElement);",
      "  } else if (event.key === 'ArrowDown') {",
      "    event.preventDefault();",
      "    var container = el.parentElement;",
      "    if (!container.classList.contains('open')) {",
      "      toggleStatusDropdown(el);",
      "    } else {",
      "      var firstItem = container.querySelector('[role=\"menuitem\"]');",
      "      if (firstItem) firstItem.focus();",
      "    }",
      "  }",
      "}",
      "",
      "function handleMenuItemKeydown(event) {",
      "  var container = event.target.closest('.status-badge-dropdown');",
      "  var items = container.querySelectorAll('[role=\"menuitem\"]');",
      "  var currentIndex = Array.from(items).indexOf(event.target);",
      "  ",
      "  if (event.key === 'ArrowDown') {",
      "    event.preventDefault();",
      "    var next = (currentIndex + 1) % items.length;",
      "    items[next].focus();",
      "  } else if (event.key === 'ArrowUp') {",
      "    event.preventDefault();",
      "    var prev = (currentIndex - 1 + items.length) % items.length;",
      "    items[prev].focus();",
      "  } else if (event.key === 'Escape') {",
      "    event.preventDefault();",
      "    closeStatusDropdown(container);",
      "  } else if (event.key === 'Tab') {",
      "    closeStatusDropdown(container);",
      "  }",
      "}",
      "",
      "document.addEventListener('click', function(e) {",
      "  var dropdowns = document.querySelectorAll('.status-badge-dropdown.open');",
      "  dropdowns.forEach(function(d) {",
      "    if (!d.contains(e.target)) {",
      "      closeStatusDropdown(d);",
      "    }",
      "  });",
      "});"
    ]

priorityDropdownJs :: Text
priorityDropdownJs =
  Text.unlines
    [ "function togglePriorityDropdown(el) {",
      "  var container = el.parentElement;",
      "  var isOpen = container.classList.toggle('open');",
      "  el.setAttribute('aria-expanded', isOpen);",
      "  if (isOpen) {",
      "    var firstItem = container.querySelector('[role=\"menuitem\"]');",
      "    if (firstItem) firstItem.focus();",
      "  }",
      "}",
      "",
      "function closePriorityDropdown(container) {",
      "  container.classList.remove('open');",
      "  var badge = container.querySelector('[role=\"button\"]');",
      "  if (badge) {",
      "    badge.setAttribute('aria-expanded', 'false');",
      "    badge.focus();",
      "  }",
      "}",
      "",
      "function handlePriorityKeydown(event, el) {",
      "  if (event.key === 'Enter' || event.key === ' ') {",
      "    event.preventDefault();",
      "    togglePriorityDropdown(el);",
      "  } else if (event.key === 'Escape') {",
      "    closePriorityDropdown(el.parentElement);",
      "  } else if (event.key === 'ArrowDown') {",
      "    event.preventDefault();",
      "    var container = el.parentElement;",
      "    if (!container.classList.contains('open')) {",
      "      togglePriorityDropdown(el);",
      "    } else {",
      "      var firstItem = container.querySelector('[role=\"menuitem\"]');",
      "      if (firstItem) firstItem.focus();",
      "    }",
      "  }",
      "}",
      "",
      "function handlePriorityMenuItemKeydown(event) {",
      "  var container = event.target.closest('.priority-badge-dropdown');",
      "  var items = container.querySelectorAll('[role=\"menuitem\"]');",
      "  var currentIndex = Array.from(items).indexOf(event.target);",
      "  ",
      "  if (event.key === 'ArrowDown') {",
      "    event.preventDefault();",
      "    var next = (currentIndex + 1) % items.length;",
      "    items[next].focus();",
      "  } else if (event.key === 'ArrowUp') {",
      "    event.preventDefault();",
      "    var prev = (currentIndex - 1 + items.length) % items.length;",
      "    items[prev].focus();",
      "  } else if (event.key === 'Escape') {",
      "    event.preventDefault();",
      "    closePriorityDropdown(container);",
      "  } else if (event.key === 'Tab') {",
      "    closePriorityDropdown(container);",
      "  }",
      "}",
      "",
      "document.addEventListener('click', function(e) {",
      "  var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
      "  dropdowns.forEach(function(d) {",
      "    if (!d.contains(e.target)) {",
      "      closePriorityDropdown(d);",
      "    }",
      "  });",
      "});"
    ]

liveToggleJs :: Text
liveToggleJs =
  Text.unlines
    [ "var liveUpdatesEnabled = true;",
      "var autoscrollEnabled = true;",
      "",
      "function toggleLiveUpdates() {",
      "  liveUpdatesEnabled = !liveUpdatesEnabled;",
      "  var btn = document.getElementById('live-toggle');",
      "  if (btn) {",
      "    btn.classList.toggle('timeline-live-paused', !liveUpdatesEnabled);",
      "  }",
      "}",
      "",
      "function toggleAutoscroll() {",
      "  autoscrollEnabled = !autoscrollEnabled;",
      "  var btn = document.getElementById('autoscroll-toggle');",
      "  if (btn) {",
      "    btn.classList.toggle('timeline-autoscroll-disabled', !autoscrollEnabled);",
      "  }",
      "}",
      "",
      "document.body.addEventListener('htmx:beforeRequest', function(evt) {",
      "  var timeline = document.getElementById('unified-timeline');",
      "  if (timeline && timeline.contains(evt.target) && !liveUpdatesEnabled) {",
      "    evt.preventDefault();",
      "  }",
      "});",
      "",
      "document.body.addEventListener('htmx:afterSettle', function(evt) {",
      "  if (autoscrollEnabled) {",
      "    var log = document.querySelector('.timeline-events');",
      "    if (log) {",
      "      log.scrollTop = log.scrollHeight;",
      "    }",
      "  }",
      "});"
    ]

pageBody :: (Monad m) => Lucid.HtmlT m () -> Lucid.HtmlT m ()
pageBody content =
  Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
    navbar
    content

-- * Breadcrumbs

data Breadcrumb = Breadcrumb
  { _crumbLabel :: Text,
    _crumbHref :: Maybe Text
  }

type Breadcrumbs = [Breadcrumb]

pageBodyWithCrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m () -> Lucid.HtmlT m ()
pageBodyWithCrumbs crumbs content =
  Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
    navbar
    unless (null crumbs) <| do
      Lucid.div_ [Lucid.class_ "breadcrumb-container"] <| do
        Lucid.div_ [Lucid.class_ "container"] <| renderBreadcrumbs crumbs
    content

renderBreadcrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m ()
renderBreadcrumbs [] = pure ()
renderBreadcrumbs crumbs =
  Lucid.nav_ [Lucid.class_ "breadcrumbs", Lucid.makeAttribute "aria-label" "Breadcrumb"] <| do
    Lucid.ol_ [Lucid.class_ "breadcrumb-list"] <| do
      traverse_ renderCrumb (zip [0 ..] crumbs)
  where
    renderCrumb :: (Monad m') => (Int, Breadcrumb) -> Lucid.HtmlT m' ()
    renderCrumb (idx, Breadcrumb label mHref) = do
      Lucid.li_ [Lucid.class_ "breadcrumb-item"] <| do
        when (idx > 0) <| Lucid.span_ [Lucid.class_ "breadcrumb-sep"] ">"
        case mHref of
          Just href -> Lucid.a_ [Lucid.href_ href] (Lucid.toHtml label)
          Nothing -> Lucid.span_ [Lucid.class_ "breadcrumb-current"] (Lucid.toHtml label)

getAncestors :: [TaskCore.Task] -> TaskCore.Task -> [TaskCore.Task]
getAncestors allTasks task =
  case TaskCore.taskParent task of
    Nothing -> [task]
    Just pid -> case TaskCore.findTask pid allTasks of
      Nothing -> [task]
      Just parent -> getAncestors allTasks parent ++ [task]

taskBreadcrumbs :: [TaskCore.Task] -> TaskCore.Task -> Breadcrumbs
taskBreadcrumbs allTasks task =
  let ancestors = getAncestors allTasks task
      taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
      currentCrumb = Breadcrumb (TaskCore.taskId task) Nothing
   in [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks")]
        ++ taskCrumbs
        ++ [currentCrumb]

-- * Navbar

navbar :: (Monad m) => Lucid.HtmlT m ()
navbar =
  Lucid.nav_ [Lucid.class_ "navbar"] <| do
    Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Junior"
    Lucid.input_
      [ Lucid.type_ "checkbox",
        Lucid.id_ "navbar-toggle",
        Lucid.class_ "navbar-toggle-checkbox"
      ]
    Lucid.label_
      [ Lucid.for_ "navbar-toggle",
        Lucid.class_ "navbar-hamburger"
      ]
      <| do
        Lucid.span_ [Lucid.class_ "hamburger-line"] ""
        Lucid.span_ [Lucid.class_ "hamburger-line"] ""
        Lucid.span_ [Lucid.class_ "hamburger-line"] ""
    Lucid.div_ [Lucid.class_ "navbar-links"] <| do
      Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard"
      Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
        Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Tasks ▾"
        Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
          Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-dropdown-item"] "Ready"
          Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-dropdown-item"] "Blocked"
          Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-dropdown-item"] "Human Action"
          Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-dropdown-item"] "All"
      Lucid.div_ [Lucid.class_ "navbar-dropdown"] <| do
        Lucid.button_ [Lucid.class_ "navbar-dropdown-btn"] "Plans ▾"
        Lucid.div_ [Lucid.class_ "navbar-dropdown-content"] <| do
          Lucid.a_ [Lucid.href_ "/epics", Lucid.class_ "navbar-dropdown-item"] "Epics"
          Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "navbar-dropdown-item"] "KB"
      Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "navbar-link"] "Stats"

-- * Badges

statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m ()
statusBadge status =
  let (cls, label) = case status of
        TaskCore.Draft -> ("badge badge-draft", "Draft")
        TaskCore.Open -> ("badge badge-open", "Open")
        TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
        TaskCore.Review -> ("badge badge-review", "Review")
        TaskCore.Approved -> ("badge badge-approved", "Approved")
        TaskCore.Done -> ("badge badge-done", "Done")
        TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
   in Lucid.span_ [Lucid.class_ cls] label

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

-- * Sort dropdown

sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
sortDropdown basePath currentSort =
  Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
    Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
    Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
      Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
        <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
      Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
        sortOption basePath SortNewest currentSort
        sortOption basePath SortOldest currentSort
        sortOption basePath SortUpdated currentSort
        sortOption basePath SortPriorityHigh currentSort
        sortOption basePath SortPriorityLow currentSort

sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
sortOption basePath option currentSort =
  let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
      href = basePath <> "?sort=" <> sortOrderToParam option
   in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))

-- * Progress bars

multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
multiColorProgressBar stats =
  let total = TaskCore.totalTasks stats
      doneCount = TaskCore.doneTasks stats
      inProgressCount = TaskCore.inProgressTasks stats
      openCount = TaskCore.openTasks stats + TaskCore.reviewTasks stats + TaskCore.approvedTasks stats
      donePct = if total == 0 then 0 else (doneCount * 100) `div` total
      inProgressPct = if total == 0 then 0 else (inProgressCount * 100) `div` total
      openPct = if total == 0 then 0 else (openCount * 100) `div` total
   in Lucid.div_ [Lucid.class_ "multi-progress-container"] <| do
        Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
          when (donePct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-done",
                Lucid.style_ ("width: " <> tshow donePct <> "%"),
                Lucid.title_ (tshow doneCount <> " done")
              ]
              ""
          when (inProgressPct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-inprogress",
                Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
                Lucid.title_ (tshow inProgressCount <> " in progress")
              ]
              ""
          when (openPct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-open",
                Lucid.style_ ("width: " <> tshow openPct <> "%"),
                Lucid.title_ (tshow openCount <> " open")
              ]
              ""
        Lucid.div_ [Lucid.class_ "progress-legend"] <| do
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
            Lucid.toHtml ("Done " <> tshow doneCount)
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
            Lucid.toHtml ("In Progress " <> tshow inProgressCount)
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
            Lucid.toHtml ("Open " <> tshow openCount)

epicProgressBar :: (Monad m) => Int -> Int -> Int -> Int -> Lucid.HtmlT m ()
epicProgressBar doneCount inProgressCount openCount totalCount =
  let donePct = if totalCount == 0 then 0 else (doneCount * 100) `div` totalCount
      inProgressPct = if totalCount == 0 then 0 else (inProgressCount * 100) `div` totalCount
      openPct = if totalCount == 0 then 0 else (openCount * 100) `div` totalCount
   in Lucid.div_ [Lucid.class_ "multi-progress-container epic-progress"] <| do
        Lucid.div_ [Lucid.class_ "multi-progress-bar"] <| do
          when (donePct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-done",
                Lucid.style_ ("width: " <> tshow donePct <> "%"),
                Lucid.title_ (tshow doneCount <> " done")
              ]
              ""
          when (inProgressPct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-inprogress",
                Lucid.style_ ("width: " <> tshow inProgressPct <> "%"),
                Lucid.title_ (tshow inProgressCount <> " in progress")
              ]
              ""
          when (openPct > 0)
            <| Lucid.div_
              [ Lucid.class_ "multi-progress-segment progress-open",
                Lucid.style_ ("width: " <> tshow openPct <> "%"),
                Lucid.title_ (tshow openCount <> " open")
              ]
              ""
        Lucid.div_ [Lucid.class_ "progress-legend"] <| do
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-done"] ""
            Lucid.toHtml (tshow doneCount)
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-inprogress"] ""
            Lucid.toHtml (tshow inProgressCount)
          Lucid.span_ [Lucid.class_ "legend-item"] <| do
            Lucid.span_ [Lucid.class_ "legend-dot legend-open"] ""
            Lucid.toHtml (tshow openCount)

-- * Status badge with form

statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
statusBadgeWithForm status tid =
  Lucid.div_
    [ Lucid.id_ "status-badge-container",
      Lucid.class_ "status-badge-dropdown"
    ]
    <| do
      clickableBadge status tid
      statusDropdownOptions status tid

clickableBadge :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
clickableBadge status _tid =
  let (cls, label) = case status of
        TaskCore.Draft -> ("badge badge-draft status-badge-clickable", "Draft" :: Text)
        TaskCore.Open -> ("badge badge-open status-badge-clickable", "Open")
        TaskCore.InProgress -> ("badge badge-inprogress status-badge-clickable", "In Progress")
        TaskCore.Review -> ("badge badge-review status-badge-clickable", "Review")
        TaskCore.Approved -> ("badge badge-approved status-badge-clickable", "Approved")
        TaskCore.Done -> ("badge badge-done status-badge-clickable", "Done")
        TaskCore.NeedsHelp -> ("badge badge-needshelp status-badge-clickable", "Needs Help")
   in Lucid.span_
        [ Lucid.class_ cls,
          Lucid.tabindex_ "0",
          Lucid.role_ "button",
          Lucid.makeAttribute "aria-haspopup" "true",
          Lucid.makeAttribute "aria-expanded" "false",
          Lucid.makeAttribute "onclick" "toggleStatusDropdown(this)",
          Lucid.makeAttribute "onkeydown" "handleStatusKeydown(event, this)"
        ]
        <| do
          Lucid.toHtml label
          Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"

statusDropdownOptions :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
statusDropdownOptions currentStatus tid =
  Lucid.div_
    [ Lucid.class_ "status-dropdown-menu",
      Lucid.role_ "menu",
      Lucid.makeAttribute "aria-label" "Change task status"
    ]
    <| do
      statusOption TaskCore.Draft currentStatus tid
      statusOption TaskCore.Open currentStatus tid
      statusOption TaskCore.InProgress currentStatus tid
      statusOption TaskCore.Review currentStatus tid
      statusOption TaskCore.Approved currentStatus tid
      statusOption TaskCore.Done currentStatus tid
      statusOption TaskCore.NeedsHelp currentStatus tid

statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Text -> Lucid.HtmlT m ()
statusOption opt currentStatus tid =
  let (cls, label) = case opt of
        TaskCore.Draft -> ("badge badge-draft", "Draft" :: Text)
        TaskCore.Open -> ("badge badge-open", "Open")
        TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
        TaskCore.Review -> ("badge badge-review", "Review")
        TaskCore.Approved -> ("badge badge-approved", "Approved")
        TaskCore.Done -> ("badge badge-done", "Done")
        TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
      isSelected = opt == currentStatus
      optClass = cls <> " status-dropdown-option" <> if isSelected then " selected" else ""
   in Lucid.form_
        [ Lucid.class_ "status-option-form",
          Lucid.role_ "none",
          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
          Lucid.makeAttribute "hx-target" "#status-badge-container",
          Lucid.makeAttribute "hx-swap" "outerHTML"
        ]
        <| do
          Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ (tshow opt)]
          Lucid.button_
            [ Lucid.type_ "submit",
              Lucid.class_ optClass,
              Lucid.role_ "menuitem",
              Lucid.tabindex_ "-1",
              Lucid.makeAttribute "onkeydown" "handleMenuItemKeydown(event)"
            ]
            (Lucid.toHtml label)

-- * Priority badge with form

priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
priorityBadgeWithForm priority tid =
  Lucid.div_
    [ Lucid.id_ "priority-badge-container",
      Lucid.class_ "priority-badge-dropdown"
    ]
    <| do
      clickablePriorityBadge priority tid
      priorityDropdownOptions priority tid

clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
clickablePriorityBadge priority _tid =
  let (cls, label) = case priority of
        TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
        TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
        TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
        TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
        TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
   in Lucid.span_
        [ Lucid.class_ cls,
          Lucid.tabindex_ "0",
          Lucid.role_ "button",
          Lucid.makeAttribute "aria-haspopup" "true",
          Lucid.makeAttribute "aria-expanded" "false",
          Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
          Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
        ]
        <| do
          Lucid.toHtml label
          Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"

priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
priorityDropdownOptions currentPriority tid =
  Lucid.div_
    [ Lucid.class_ "priority-dropdown-menu",
      Lucid.role_ "menu",
      Lucid.makeAttribute "aria-label" "Change task priority"
    ]
    <| do
      priorityOption TaskCore.P0 currentPriority tid
      priorityOption TaskCore.P1 currentPriority tid
      priorityOption TaskCore.P2 currentPriority tid
      priorityOption TaskCore.P3 currentPriority tid
      priorityOption TaskCore.P4 currentPriority tid

priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
priorityOption opt currentPriority tid =
  let (cls, label) = case opt of
        TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
        TaskCore.P1 -> ("badge badge-p1", "P1 High")
        TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
        TaskCore.P3 -> ("badge badge-p3", "P3 Low")
        TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
      isSelected = opt == currentPriority
      optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
   in Lucid.form_
        [ Lucid.class_ "priority-option-form",
          Lucid.role_ "none",
          Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
          Lucid.makeAttribute "hx-target" "#priority-badge-container",
          Lucid.makeAttribute "hx-swap" "outerHTML"
        ]
        <| do
          Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
          Lucid.button_
            [ Lucid.type_ "submit",
              Lucid.class_ optClass,
              Lucid.role_ "menuitem",
              Lucid.tabindex_ "-1",
              Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
            ]
            (Lucid.toHtml label)

-- * Task rendering

renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderTaskCard t =
  Lucid.a_
    [ Lucid.class_ "task-card task-card-link",
      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
    ]
    <| do
      Lucid.div_ [Lucid.class_ "task-header"] <| do
        Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
        statusBadge (TaskCore.taskStatus t)
        Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
      Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))

renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
renderBlockedTaskCard (t, impact) =
  Lucid.a_
    [ Lucid.class_ "task-card task-card-link",
      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
    ]
    <| do
      Lucid.div_ [Lucid.class_ "task-header"] <| do
        Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
        statusBadge (TaskCore.taskStatus t)
        Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
        when (impact > 0)
          <| Lucid.span_ [Lucid.class_ "blocking-impact"] (Lucid.toHtml ("Blocks " <> tshow impact))
      Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))

renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderListGroupItem t =
  Lucid.a_
    [ Lucid.class_ "list-group-item",
      Lucid.href_ ("/tasks/" <> TaskCore.taskId t),
      Lucid.makeAttribute "hx-boost" "true",
      Lucid.makeAttribute "hx-target" "body",
      Lucid.makeAttribute "hx-swap" "innerHTML"
    ]
    <| do
      Lucid.div_ [Lucid.class_ "list-group-item-content"] <| do
        Lucid.span_ [Lucid.class_ "list-group-item-id"] (Lucid.toHtml (TaskCore.taskId t))
        Lucid.span_ [Lucid.class_ "list-group-item-title"] (Lucid.toHtml (TaskCore.taskTitle t))
      Lucid.div_ [Lucid.class_ "list-group-item-meta"] <| do
        statusBadge (TaskCore.taskStatus t)
        Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))

renderEpicReviewCard :: (Monad m) => TaskCore.EpicForReview -> Lucid.HtmlT m ()
renderEpicReviewCard epicReview = do
  let task = TaskCore.epicTask epicReview
      total = TaskCore.epicTotal epicReview
      completed = TaskCore.epicCompleted epicReview
      progressText = tshow completed <> "/" <> tshow total <> " subtasks done"
  Lucid.div_ [Lucid.class_ "task-card"] <| do
    Lucid.div_ [Lucid.class_ "task-card-header"] <| do
      Lucid.div_ [Lucid.class_ "task-title-row"] <| do
        Lucid.a_
          [Lucid.href_ ("/tasks/" <> TaskCore.taskId task), Lucid.class_ "task-link"]
          <| Lucid.toHtml (TaskCore.taskTitle task)
        Lucid.span_ [Lucid.class_ "badge badge-epic"] "Epic"
      Lucid.span_ [Lucid.class_ "task-id"] <| Lucid.toHtml (TaskCore.taskId task)
    Lucid.div_ [Lucid.class_ "task-card-body"] <| do
      Lucid.div_ [Lucid.class_ "progress-info"] <| do
        Lucid.span_ [Lucid.class_ "badge badge-success"] <| Lucid.toHtml progressText
      Lucid.div_ [Lucid.class_ "epic-actions"] <| do
        Lucid.form_
          [ Lucid.method_ "POST",
            Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status"),
            Lucid.class_ "inline-form"
          ]
          <| do
            Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ "done"]
            Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-success btn-sm"] "Approve & Close"

renderEpicCardWithStats :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> Lucid.HtmlT m ()
renderEpicCardWithStats allTasks t =
  let children = getDescendants allTasks (TaskCore.taskId t)
      openCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Open]
      inProgressCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.InProgress]
      reviewCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Review]
      doneCount = length [c | c <- children, TaskCore.taskStatus c == TaskCore.Done]
      totalCount = length children
      openAndReview = openCount + reviewCount
   in Lucid.a_
        [ Lucid.class_ "task-card task-card-link",
          Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
        ]
        <| do
          Lucid.div_ [Lucid.class_ "task-header"] <| do
            Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
            statusBadge (TaskCore.taskStatus t)
            Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
          Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
          when (totalCount > 0) <| epicProgressBar doneCount inProgressCount openAndReview totalCount
          unless (Text.null (TaskCore.taskDescription t))
            <| Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 (TaskCore.taskDescription t) <> "..."))

getDescendants :: [TaskCore.Task] -> Text -> [TaskCore.Task]
getDescendants allTasks parentId =
  let children = [c | c <- allTasks, maybe False (TaskCore.matchesId parentId) (TaskCore.taskParent c)]
   in children ++ concatMap (getDescendants allTasks <. TaskCore.taskId) children

-- * Aggregated metrics

renderAggregatedMetrics :: (Monad m) => [TaskCore.Task] -> TaskCore.Task -> TaskCore.AggregatedMetrics -> Lucid.HtmlT m ()
renderAggregatedMetrics allTasks task metrics =
  let descendants = getDescendants allTasks (TaskCore.taskId task)
      totalCount = length descendants
      costCents = TaskCore.aggTotalCostCents metrics
      durationSecs = TaskCore.aggTotalDurationSeconds metrics
      completedCount = TaskCore.aggCompletedTasks metrics
      tokensUsed = TaskCore.aggTotalTokens metrics
   in Lucid.div_ [Lucid.class_ "detail-section aggregated-metrics"] <| do
        Lucid.h3_ "Execution Summary"
        Lucid.div_ [Lucid.class_ "metrics-grid"] <| do
          Lucid.div_ [Lucid.class_ "metric-card"] <| do
            Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow completedCount <> "/" <> tshow totalCount))
            Lucid.div_ [Lucid.class_ "metric-label"] "Tasks Completed"
          Lucid.div_ [Lucid.class_ "metric-card"] <| do
            Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostMetric costCents))
            Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost"
          Lucid.div_ [Lucid.class_ "metric-card"] <| do
            Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurationMetric durationSecs))
            Lucid.div_ [Lucid.class_ "metric-label"] "Total Time"
          when (tokensUsed > 0) <| do
            Lucid.div_ [Lucid.class_ "metric-card"] <| do
              Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTokensMetric tokensUsed))
              Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used"
  where
    formatCostMetric :: Int -> Text
    formatCostMetric cents =
      let dollars = fromIntegral cents / 100.0 :: Double
       in "$" <> Text.pack (showFFloat (Just 2) dollars "")

    formatDurationMetric :: Int -> Text
    formatDurationMetric secs
      | secs < 60 = tshow secs <> "s"
      | secs < 3600 =
          let mins = secs `div` 60
              remSecs = secs `mod` 60
           in tshow mins <> "m " <> tshow remSecs <> "s"
      | otherwise =
          let hrs = secs `div` 3600
              mins = (secs `mod` 3600) `div` 60
           in tshow hrs <> "h " <> tshow mins <> "m"

    formatTokensMetric :: Int -> Text
    formatTokensMetric t
      | t < 1000 = tshow t
      | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
      | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"

-- * Retry context banner

renderRetryContextBanner :: (Monad m) => Text -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
renderRetryContextBanner _ Nothing = pure ()
renderRetryContextBanner tid (Just ctx) =
  Lucid.div_ [Lucid.class_ bannerClass] <| do
    Lucid.div_ [Lucid.class_ "retry-banner-header"] <| do
      Lucid.span_ [Lucid.class_ "retry-icon"] retryIcon
      Lucid.span_ [Lucid.class_ "retry-attempt"] (Lucid.toHtml attemptText)
      when maxRetriesExceeded
        <| Lucid.span_ [Lucid.class_ "retry-warning-badge"] "Needs Human Intervention"

    Lucid.div_ [Lucid.class_ "retry-banner-details"] <| do
      Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
        Lucid.span_ [Lucid.class_ "retry-label"] "Failure Reason:"
        Lucid.span_ [Lucid.class_ "retry-value"] (Lucid.toHtml (summarizeReason (TaskCore.retryReason ctx)))

      let commit = TaskCore.retryOriginalCommit ctx
      unless (Text.null commit) <| do
        Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
          Lucid.span_ [Lucid.class_ "retry-label"] "Original Commit:"
          Lucid.code_ [Lucid.class_ "retry-commit"] (Lucid.toHtml (Text.take 8 commit))

      let conflicts = TaskCore.retryConflictFiles ctx
      unless (null conflicts) <| do
        Lucid.div_ [Lucid.class_ "retry-detail-row"] <| do
          Lucid.span_ [Lucid.class_ "retry-label"] "Conflict Files:"
          Lucid.ul_ [Lucid.class_ "retry-conflict-list"]
            <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflicts

    when maxRetriesExceeded <| do
      Lucid.div_
        [Lucid.class_ "retry-warning-message"]
        "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."

      Lucid.p_ [Lucid.class_ "retry-hint"] "Use comments below to provide guidance for retry."

      Lucid.div_ [Lucid.class_ "retry-reset-section"] <| do
        Lucid.h4_ "Reset Retries"
        Lucid.p_ [Lucid.class_ "notes-help"] "Clear retry context and give task a fresh start:"
        Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/reset-retries")] <| do
          Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reset-btn"] "Reset Retries"
  where
    attempt = TaskCore.retryAttempt ctx
    maxRetriesExceeded = attempt >= 3
    bannerClass = if maxRetriesExceeded then "retry-banner retry-banner-critical" else "retry-banner retry-banner-warning"
    retryIcon = if maxRetriesExceeded then "⚠" else "↻"
    attemptText = "Attempt " <> tshow attempt <> " of 3"

    summarizeReason :: Text -> Text
    summarizeReason reason
      | "rejected:" `Text.isPrefixOf` reason = "Rejected: " <> Text.strip (Text.drop 9 reason)
      | "Test failure:" `Text.isPrefixOf` reason = "Test failure (see details below)"
      | "MERGE CONFLICT" `Text.isPrefixOf` reason = "Merge conflict with concurrent changes"
      | otherwise = Text.take 100 reason <> if Text.length reason > 100 then "..." else ""

-- * Markdown rendering

renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m ()
renderMarkdown input = renderBlocks (parseBlocks (Text.lines input))

data MarkdownBlock
  = MdHeader Int Text
  | MdParagraph [Text]
  | MdCodeBlock [Text]
  | MdList [Text]
  deriving (Show, Eq)

parseBlocks :: [Text] -> [MarkdownBlock]
parseBlocks [] = []
parseBlocks lns = case lns of
  (l : rest)
    | "```" `Text.isPrefixOf` l ->
        let (codeLines, afterCode) = List.span (not <. Text.isPrefixOf "```") rest
            remaining = List.drop 1 afterCode
         in MdCodeBlock codeLines : parseBlocks remaining
    | "### " `Text.isPrefixOf` l ->
        MdHeader 3 (Text.drop 4 l) : parseBlocks rest
    | "## " `Text.isPrefixOf` l ->
        MdHeader 2 (Text.drop 3 l) : parseBlocks rest
    | "# " `Text.isPrefixOf` l ->
        MdHeader 1 (Text.drop 2 l) : parseBlocks rest
    | isListItem l ->
        let (listLines, afterList) = List.span isListItem lns
         in MdList (map stripListPrefix listLines) : parseBlocks afterList
    | Text.null (Text.strip l) ->
        parseBlocks rest
    | otherwise ->
        let (paraLines, afterPara) = List.span isParagraphLine lns
         in MdParagraph paraLines : parseBlocks afterPara
  where
    isListItem t =
      let stripped = Text.stripStart t
       in "- " `Text.isPrefixOf` stripped || "* " `Text.isPrefixOf` stripped
    stripListPrefix t =
      let stripped = Text.stripStart t
       in Text.drop 2 stripped
    isParagraphLine t =
      not (Text.null (Text.strip t))
        && not ("```" `Text.isPrefixOf` t)
        && not ("#" `Text.isPrefixOf` t)
        && not (isListItem t)

renderBlocks :: (Monad m) => [MarkdownBlock] -> Lucid.HtmlT m ()
renderBlocks = traverse_ renderBlock

renderBlock :: (Monad m) => MarkdownBlock -> Lucid.HtmlT m ()
renderBlock block = case block of
  MdHeader 1 txt -> Lucid.h2_ [Lucid.class_ "md-h1"] (renderInline txt)
  MdHeader 2 txt -> Lucid.h3_ [Lucid.class_ "md-h2"] (renderInline txt)
  MdHeader 3 txt -> Lucid.h4_ [Lucid.class_ "md-h3"] (renderInline txt)
  MdHeader _ txt -> Lucid.h4_ (renderInline txt)
  MdParagraph lns -> Lucid.p_ [Lucid.class_ "md-para"] (renderInline (Text.unlines lns))
  MdCodeBlock lns -> Lucid.pre_ [Lucid.class_ "md-code"] (Lucid.code_ (Lucid.toHtml (Text.unlines lns)))
  MdList items -> Lucid.ul_ [Lucid.class_ "md-list"] (traverse_ renderListItem items)

renderListItem :: (Monad m) => Text -> Lucid.HtmlT m ()
renderListItem txt = Lucid.li_ (renderInline txt)

renderInline :: (Monad m) => Text -> Lucid.HtmlT m ()
renderInline txt = renderInlineParts (parseInline txt)

data InlinePart = PlainText Text | InlineCode Text | BoldText Text
  deriving (Show, Eq)

parseInline :: Text -> [InlinePart]
parseInline t
  | Text.null t = []
  | otherwise = case Text.breakOn "`" t of
      (before, rest)
        | Text.null rest -> parseBold before
        | otherwise ->
            let afterTick = Text.drop 1 rest
             in case Text.breakOn "`" afterTick of
                  (code, rest2)
                    | Text.null rest2 ->
                        parseBold before ++ [PlainText ("`" <> afterTick)]
                    | otherwise ->
                        parseBold before ++ [InlineCode code] ++ parseInline (Text.drop 1 rest2)

parseBold :: Text -> [InlinePart]
parseBold t
  | Text.null t = []
  | otherwise = case Text.breakOn "**" t of
      (before, rest)
        | Text.null rest -> [PlainText before | not (Text.null before)]
        | otherwise ->
            let afterBold = Text.drop 2 rest
             in case Text.breakOn "**" afterBold of
                  (boldText, rest2)
                    | Text.null rest2 ->
                        [PlainText before | not (Text.null before)] ++ [PlainText ("**" <> afterBold)]
                    | otherwise ->
                        [PlainText before | not (Text.null before)]
                          ++ [BoldText boldText]
                          ++ parseBold (Text.drop 2 rest2)

renderInlineParts :: (Monad m) => [InlinePart] -> Lucid.HtmlT m ()
renderInlineParts = traverse_ renderInlinePart

renderInlinePart :: (Monad m) => InlinePart -> Lucid.HtmlT m ()
renderInlinePart part = case part of
  PlainText txt -> Lucid.toHtml txt
  InlineCode txt -> Lucid.code_ [Lucid.class_ "md-inline-code"] (Lucid.toHtml txt)
  BoldText txt -> Lucid.strong_ (Lucid.toHtml txt)

-- * Comment form

commentForm :: (Monad m) => Text -> Lucid.HtmlT m ()
commentForm tid =
  Lucid.form_
    [ Lucid.method_ "POST",
      Lucid.action_ ("/tasks/" <> tid <> "/comment"),
      Lucid.class_ "comment-form"
    ]
    <| do
      Lucid.textarea_
        [ Lucid.name_ "comment",
          Lucid.placeholder_ "Add a comment...",
          Lucid.rows_ "3",
          Lucid.class_ "comment-textarea"
        ]
        ""
      Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Post Comment"

-- * Live toggles

renderLiveToggle :: (Monad m) => Lucid.HtmlT m ()
renderLiveToggle =
  Lucid.button_
    [ Lucid.class_ "timeline-live-toggle",
      Lucid.id_ "live-toggle",
      Lucid.makeAttribute "onclick" "toggleLiveUpdates()",
      Lucid.title_ "Click to pause/resume live updates"
    ]
    " LIVE"

renderAutoscrollToggle :: (Monad m) => Lucid.HtmlT m ()
renderAutoscrollToggle =
  Lucid.button_
    [ Lucid.class_ "timeline-autoscroll-toggle",
      Lucid.id_ "autoscroll-toggle",
      Lucid.makeAttribute "onclick" "toggleAutoscroll()",
      Lucid.title_ "Toggle automatic scrolling to newest events"
    ]
    " ⬇ Auto-scroll"

-- * Cost/Token metrics

aggregateCostMetrics :: [TaskCore.StoredEvent] -> (Int, Int)
aggregateCostMetrics events =
  let costEvents = filter (\e -> TaskCore.storedEventType e == "Cost") events
      aggregateOne (totalCents, totalTokens) event =
        case Aeson.decode (LBS.fromStrict (str (TaskCore.storedEventContent event))) of
          Just (Aeson.Object obj) ->
            let cents = case KeyMap.lookup "cents" obj of
                  Just (Aeson.Number n) -> floor n
                  _ -> 0
                tokens = case KeyMap.lookup "tokens" obj of
                  Just (Aeson.Number n) -> floor n
                  _ -> 0
             in (totalCents + cents, totalTokens + tokens)
          _ -> (totalCents, totalTokens)
   in foldl' aggregateOne (0, 0) costEvents

formatCostHeader :: Int -> Text
formatCostHeader cents =
  let dollars = fromIntegral cents / 100.0 :: Double
   in "$" <> Text.pack (showFFloat (Just 2) dollars "")

formatTokensHeader :: Int -> Text
formatTokensHeader t
  | t < 1000 = tshow t
  | t < 1000000 = Text.pack (showFFloat (Just 1) (fromIntegral t / 1000.0 :: Double) "") <> "K"
  | otherwise = Text.pack (showFFloat (Just 2) (fromIntegral t / 1000000.0 :: Double) "") <> "M"

-- * Timeline

renderUnifiedTimeline :: (Monad m) => Text -> [TaskCore.Comment] -> [TaskCore.StoredEvent] -> TaskCore.Status -> UTCTime -> Lucid.HtmlT m ()
renderUnifiedTimeline tid legacyComments events status now = do
  let isInProgress = status == TaskCore.InProgress
      pollAttrs =
        if isInProgress
          then
            [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> tid <> "/events"),
              Lucid.makeAttribute "hx-trigger" "every 3s",
              Lucid.makeAttribute "hx-swap" "innerHTML",
              Lucid.makeAttribute "hx-on::before-request" "var log = this.querySelector('.timeline-events'); if(log) this.dataset.scroll = log.scrollTop",
              Lucid.makeAttribute "hx-on::after-swap" "var log = this.querySelector('.timeline-events'); if(log && this.dataset.scroll) log.scrollTop = this.dataset.scroll"
            ]
          else []
      nonCostEvents = filter (\e -> TaskCore.storedEventType e /= "Cost") events
      eventCount = length nonCostEvents + length legacyComments
      (totalCents, totalTokens) = aggregateCostMetrics events
  Lucid.div_ ([Lucid.class_ "unified-timeline-section", Lucid.id_ "unified-timeline"] <> pollAttrs) <| do
    Lucid.h3_ <| do
      Lucid.toHtml ("Timeline (" <> tshow eventCount <> ")")
      when (totalCents > 0 || totalTokens > 0) <| do
        Lucid.span_ [Lucid.class_ "timeline-cost-summary"] <| do
          metaSep
          when (totalCents > 0) <| Lucid.toHtml (formatCostHeader totalCents)
          when (totalCents > 0 && totalTokens > 0) <| metaSep
          when (totalTokens > 0) <| Lucid.toHtml (formatTokensHeader totalTokens <> " tokens")
      when isInProgress <| do
        renderLiveToggle
        renderAutoscrollToggle

    if null nonCostEvents && null legacyComments
      then Lucid.p_ [Lucid.class_ "empty-msg"] "No activity yet."
      else do
        Lucid.div_ [Lucid.class_ "timeline-events"] <| do
          traverse_ (renderTimelineEvent now) nonCostEvents
        when isInProgress <| timelineScrollScript

    commentForm tid

renderTimelineEvent :: (Monad m) => UTCTime -> TaskCore.StoredEvent -> Lucid.HtmlT m ()
renderTimelineEvent now event =
  let eventType = TaskCore.storedEventType event
      content = TaskCore.storedEventContent event
      timestamp = TaskCore.storedEventTimestamp event
      actor = TaskCore.storedEventActor event
      eventId = TaskCore.storedEventId event
      (icon, label) = eventTypeIconAndLabel eventType
   in Lucid.div_
        [ Lucid.class_ ("timeline-event timeline-event-" <> eventType),
          Lucid.makeAttribute "data-event-id" (tshow eventId)
        ]
        <| do
          case eventType of
            "comment" -> renderCommentTimelineEvent content actor timestamp now
            "status_change" -> renderStatusChangeEvent content actor timestamp now
            "claim" -> renderActivityEvent icon label content actor timestamp now
            "running" -> renderActivityEvent icon label content actor timestamp now
            "reviewing" -> renderActivityEvent icon label content actor timestamp now
            "retrying" -> renderActivityEvent icon label content actor timestamp now
            "complete" -> renderActivityEvent icon label content actor timestamp now
            "error" -> renderErrorTimelineEvent content actor timestamp now
            "Assistant" -> renderAssistantTimelineEvent content actor timestamp now
            "ToolCall" -> renderToolCallTimelineEvent content actor timestamp now
            "ToolResult" -> renderToolResultTimelineEvent content actor timestamp now
            "Cost" -> pure ()
            "Checkpoint" -> renderCheckpointEvent content actor timestamp now
            "Guardrail" -> renderGuardrailEvent content actor timestamp now
            _ -> renderGenericEvent eventType content actor timestamp now

eventTypeIconAndLabel :: Text -> (Text, Text)
eventTypeIconAndLabel "comment" = ("💬", "Comment")
eventTypeIconAndLabel "status_change" = ("🔄", "Status")
eventTypeIconAndLabel "claim" = ("🤖", "Claimed")
eventTypeIconAndLabel "running" = ("▶️", "Running")
eventTypeIconAndLabel "reviewing" = ("👀", "Reviewing")
eventTypeIconAndLabel "retrying" = ("🔁", "Retrying")
eventTypeIconAndLabel "complete" = ("✅", "Complete")
eventTypeIconAndLabel "error" = ("❌", "Error")
eventTypeIconAndLabel "Assistant" = ("💭", "Thought")
eventTypeIconAndLabel "ToolCall" = ("🔧", "Tool")
eventTypeIconAndLabel "ToolResult" = ("📄", "Result")
eventTypeIconAndLabel "Cost" = ("💰", "Cost")
eventTypeIconAndLabel "Checkpoint" = ("📍", "Checkpoint")
eventTypeIconAndLabel "Guardrail" = ("⚠️", "Guardrail")
eventTypeIconAndLabel t = ("📝", t)

renderActorLabel :: (Monad m) => TaskCore.CommentAuthor -> Lucid.HtmlT m ()
renderActorLabel actor =
  let (cls, label) :: (Text, Text) = case actor of
        TaskCore.Human -> ("actor-human", "human")
        TaskCore.Junior -> ("actor-junior", "junior")
        TaskCore.System -> ("actor-system", "system")
   in Lucid.span_ [Lucid.class_ ("actor-label " <> cls)] (Lucid.toHtml ("[" <> label <> "]"))

renderCommentTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderCommentTimelineEvent content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-comment"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "💬"
      renderActorLabel actor
      renderRelativeTimestamp now timestamp
    Lucid.div_ [Lucid.class_ "event-content comment-bubble markdown-content"] <| do
      renderMarkdown content

renderStatusChangeEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderStatusChangeEvent content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-status-change"] <| do
    Lucid.span_ [Lucid.class_ "event-icon"] "🔄"
    renderActorLabel actor
    Lucid.span_ [Lucid.class_ "status-change-text"] (Lucid.toHtml (parseStatusChange content))
    renderRelativeTimestamp now timestamp

parseStatusChange :: Text -> Text
parseStatusChange content =
  case Aeson.decode (LBS.fromStrict (str content)) of
    Just (Aeson.Object obj) ->
      let fromStatus = case KeyMap.lookup "from" obj of
            Just (Aeson.String s) -> s
            _ -> "?"
          toStatus = case KeyMap.lookup "to" obj of
            Just (Aeson.String s) -> s
            _ -> "?"
       in fromStatus <> " → " <> toStatus
    _ -> content

renderActivityEvent :: (Monad m) => Text -> Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderActivityEvent icon label content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-activity"] <| do
    Lucid.span_ [Lucid.class_ "event-icon"] (Lucid.toHtml icon)
    Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml label)
    renderActorLabel actor
    unless (Text.null content) <| Lucid.span_ [Lucid.class_ "activity-detail"] (Lucid.toHtml content)
    renderRelativeTimestamp now timestamp

renderErrorTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderErrorTimelineEvent content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-error"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "❌"
      Lucid.span_ [Lucid.class_ "event-label"] "Error"
      renderActorLabel actor
      renderRelativeTimestamp now timestamp
    Lucid.div_ [Lucid.class_ "event-content error-message"] (Lucid.toHtml content)

renderAssistantTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderAssistantTimelineEvent content _actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-thought"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "💭"
      Lucid.span_ [Lucid.class_ "event-label"] "Thought"
      renderActorLabel TaskCore.Junior
      renderRelativeTimestamp now timestamp
    Lucid.div_ [Lucid.class_ "event-content thought-bubble markdown-content"] <| do
      let truncated = Text.take 2000 content
          isTruncated = Text.length content > 2000
      renderMarkdown truncated
      when isTruncated <| Lucid.span_ [Lucid.class_ "event-truncated"] "..."

renderToolCallTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderToolCallTimelineEvent content _actor timestamp now =
  let (toolName, args) = parseToolCallContent content
      summary = formatToolCallSummary toolName args
   in Lucid.details_ [Lucid.class_ "timeline-tool-call"] <| do
        Lucid.summary_ <| do
          Lucid.span_ [Lucid.class_ "event-icon"] "🔧"
          Lucid.span_ [Lucid.class_ "tool-name"] (Lucid.toHtml toolName)
          Lucid.span_ [Lucid.class_ "tool-summary"] (Lucid.toHtml summary)
          renderRelativeTimestamp now timestamp
        Lucid.div_ [Lucid.class_ "event-content tool-args"] <| do
          renderCollapsibleOutput args

renderToolResultTimelineEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderToolResultTimelineEvent content _actor timestamp now =
  let lineCount = length (Text.lines content)
   in Lucid.details_ [Lucid.class_ "timeline-tool-result"] <| do
        Lucid.summary_ <| do
          Lucid.span_ [Lucid.class_ "event-icon"] "📄"
          Lucid.span_ [Lucid.class_ "event-label"] "Result"
          when (lineCount > 1)
            <| Lucid.span_ [Lucid.class_ "line-count"] (Lucid.toHtml (tshow lineCount <> " lines"))
          renderRelativeTimestamp now timestamp
        Lucid.pre_ [Lucid.class_ "event-content tool-output"] (renderDecodedToolResult content)

renderCheckpointEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderCheckpointEvent content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-checkpoint"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "📍"
      Lucid.span_ [Lucid.class_ "event-label"] "Checkpoint"
      renderActorLabel actor
      renderRelativeTimestamp now timestamp
    Lucid.div_ [Lucid.class_ "event-content checkpoint-content"] (Lucid.toHtml content)

renderGuardrailEvent :: (Monad m) => Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderGuardrailEvent content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-guardrail"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "⚠️"
      Lucid.span_ [Lucid.class_ "event-label"] "Guardrail"
      renderActorLabel actor
      renderRelativeTimestamp now timestamp
    Lucid.div_ [Lucid.class_ "event-content guardrail-content"] (Lucid.toHtml content)

renderGenericEvent :: (Monad m) => Text -> Text -> TaskCore.CommentAuthor -> UTCTime -> UTCTime -> Lucid.HtmlT m ()
renderGenericEvent eventType content actor timestamp now =
  Lucid.div_ [Lucid.class_ "timeline-generic"] <| do
    Lucid.div_ [Lucid.class_ "event-header"] <| do
      Lucid.span_ [Lucid.class_ "event-icon"] "📝"
      Lucid.span_ [Lucid.class_ "event-label"] (Lucid.toHtml eventType)
      renderActorLabel actor
      renderRelativeTimestamp now timestamp
    unless (Text.null content) <| Lucid.div_ [Lucid.class_ "event-content"] (Lucid.toHtml content)

parseToolCallContent :: Text -> (Text, Text)
parseToolCallContent content =
  case Text.breakOn ":" content of
    (name, rest)
      | Text.null rest -> (content, "")
      | otherwise -> (Text.strip name, Text.strip (Text.drop 1 rest))

formatToolCallSummary :: Text -> Text -> Text
formatToolCallSummary toolName argsJson =
  case Aeson.decode (LBS.fromStrict (str argsJson)) of
    Just (Aeson.Object obj) ->
      let keyArg = case toolName of
            "run_bash" -> KeyMap.lookup "command" obj
            "read_file" -> KeyMap.lookup "path" obj
            "edit_file" -> KeyMap.lookup "path" obj
            "write_file" -> KeyMap.lookup "path" obj
            "search_codebase" -> KeyMap.lookup "pattern" obj
            "glob_files" -> KeyMap.lookup "pattern" obj
            "list_directory" -> KeyMap.lookup "path" obj
            _ -> Nothing
       in case keyArg of
            Just (Aeson.String s) -> "`" <> Text.take 100 s <> "`"
            _ -> Text.take 80 argsJson
    _ -> Text.take 80 argsJson

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)

renderDecodedToolResult :: (Monad m) => Text -> Lucid.HtmlT m ()
renderDecodedToolResult content =
  case Aeson.decode (LBS.fromStrict (str content)) of
    Just (Aeson.Object obj) ->
      case KeyMap.lookup "output" obj of
        Just (Aeson.String output) -> Lucid.toHtml output
        _ -> Lucid.toHtml content
    _ -> Lucid.toHtml content

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