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

-- : dep warp
-- : dep servant-server
-- : dep lucid
-- : dep servant-lucid
-- : dep http-api-data
-- : dep process
-- : dep clay
module Omni.Jr.Web
  ( run,
    defaultPort,
  )
where

import Alpha
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime)
import qualified Lucid
import qualified Lucid.Base as Lucid
import qualified Network.Wai.Handler.Warp as Warp
import Numeric (showFFloat)
import qualified Omni.Fact as Fact
import qualified Omni.Jr.Web.Style as Style
import qualified Omni.Task.Core as TaskCore
import Servant
import qualified Servant.HTML.Lucid as Lucid
import qualified System.Exit as Exit
import qualified System.Process as Process
import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)

type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)

defaultPort :: Warp.Port
defaultPort = 8080

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))

data TaskFilters = TaskFilters
  { filterStatus :: Maybe TaskCore.Status,
    filterPriority :: Maybe TaskCore.Priority,
    filterNamespace :: Maybe Text,
    filterType :: Maybe TaskCore.TaskType
  }
  deriving (Show, Eq)

type API =
  Get '[Lucid.HTML] HomePage
    :<|> "style.css" :> Get '[CSS] LazyText.Text
    :<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage
    :<|> "blocked" :> Get '[Lucid.HTML] BlockedPage
    :<|> "intervention" :> Get '[Lucid.HTML] InterventionPage
    :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
    :<|> "tasks"
      :> QueryParam "status" Text
      :> QueryParam "priority" Text
      :> QueryParam "namespace" Text
      :> QueryParam "type" Text
      :> Get '[Lucid.HTML] TaskListPage
    :<|> "kb" :> Get '[Lucid.HTML] KBPage
    :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
    :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
    :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
    :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
    :<|> "epics" :> Get '[Lucid.HTML] EpicsPage
    :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
    :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
    :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
    :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
    :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
    :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect
    :<|> "partials" :> "recent-activity" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityPartial
    :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
    :<|> "partials"
      :> "task-list"
      :> QueryParam "status" Text
      :> QueryParam "priority" Text
      :> QueryParam "namespace" Text
      :> QueryParam "type" Text
      :> Get '[Lucid.HTML] TaskListPartial
    :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial

data CSS

instance Accept CSS where
  contentType _ = "text/css"

instance MimeRender CSS LazyText.Text where
  mimeRender _ = LazyText.encodeUtf8

data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool UTCTime

data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] UTCTime

data BlockedPage = BlockedPage [TaskCore.Task] UTCTime

data InterventionPage = InterventionPage [TaskCore.Task] UTCTime

data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters UTCTime

data TaskDetailPage
  = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) UTCTime
  | TaskDetailNotFound Text

data GitCommit = GitCommit
  { commitHash :: Text,
    commitShortHash :: Text,
    commitSummary :: Text,
    commitAuthor :: Text,
    commitRelativeDate :: Text,
    commitFilesChanged :: Int
  }
  deriving (Show, Eq)

data TaskReviewPage
  = ReviewPageFound TaskCore.Task ReviewInfo
  | ReviewPageNotFound Text

data ReviewInfo
  = ReviewNoCommit
  | ReviewMergeConflict Text [Text]
  | ReviewReady Text Text

data TaskDiffPage
  = DiffPageFound Text Text Text
  | DiffPageNotFound Text Text

data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text)

newtype KBPage = KBPage [TaskCore.Fact]

data FactDetailPage
  = FactDetailFound TaskCore.Fact UTCTime
  | FactDetailNotFound Int

data FactEditForm = FactEditForm Text Text Text

instance FromForm FactEditForm where
  fromForm form = do
    content <- parseUnique "content" form
    let files = fromRight "" (lookupUnique "files" form)
    let confidence = fromRight "0.8" (lookupUnique "confidence" form)
    Right (FactEditForm content files confidence)

data FactCreateForm = FactCreateForm Text Text Text Text

instance FromForm FactCreateForm where
  fromForm form = do
    project <- parseUnique "project" form
    content <- parseUnique "content" form
    let files = fromRight "" (lookupUnique "files" form)
    let confidence = fromRight "0.8" (lookupUnique "confidence" form)
    Right (FactCreateForm project content files confidence)

data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task]

data RecentActivityPartial = RecentActivityPartial [TaskCore.Task] Int Bool UTCTime

newtype ReadyCountPartial = ReadyCountPartial Int

data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text

newtype TaskListPartial = TaskListPartial [TaskCore.Task]

data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime

newtype RejectForm = RejectForm (Maybe Text)

instance FromForm RejectForm where
  fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))

newtype StatusForm = StatusForm TaskCore.Status

instance FromForm StatusForm where
  fromForm form = do
    statusText <- parseUnique "status" form
    case readMaybe (Text.unpack statusText) of
      Just s -> Right (StatusForm s)
      Nothing -> Left "Invalid status"

newtype DescriptionForm = DescriptionForm Text

instance FromForm DescriptionForm where
  fromForm form = do
    desc <- parseUnique "description" form
    Right (DescriptionForm desc)

newtype NotesForm = NotesForm Text

instance FromForm NotesForm where
  fromForm form = do
    notes <- parseUnique "notes" form
    Right (NotesForm notes)

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

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);",
      "    }",
      "  });",
      "});"
    ]

navbar :: (Monad m) => Lucid.HtmlT m ()
navbar =
  Lucid.nav_ [Lucid.class_ "navbar"] <| do
    Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Jr"
    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"] "Intervention"
          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"

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")
   in Lucid.span_ [Lucid.class_ cls] label

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)

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")
   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.Open currentStatus tid
      statusOption TaskCore.InProgress currentStatus tid
      statusOption TaskCore.Review currentStatus tid
      statusOption TaskCore.Approved currentStatus tid
      statusOption TaskCore.Done 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")
      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)

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))

renderListGroupItem :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
renderListGroupItem t =
  Lucid.a_
    [ Lucid.class_ "list-group-item",
      Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
    ]
    <| 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)))

instance Lucid.ToHtml HomePage where
  toHtmlRaw = Lucid.toHtml
  toHtml (HomePage stats readyTasks recentTasks hasMoreRecent _now) =
    Lucid.doctypehtml_ <| do
      pageHead "Jr Dashboard"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h2_ "Task Status"
          Lucid.div_ [Lucid.class_ "stats-grid"] <| do
            statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open"
            statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress"
            statCard "Review" (TaskCore.reviewTasks stats) "badge-review" "/tasks?status=Review"
            statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" "/tasks?status=Approved"
            statCard "Done" (TaskCore.doneTasks stats) "badge-done" "/tasks?status=Done"

          Lucid.h2_ <| do
            "Ready Queue "
            Lucid.span_
              [ Lucid.class_ "ready-count",
                Lucid.makeAttribute "hx-get" "/partials/ready-count",
                Lucid.makeAttribute "hx-trigger" "every 5s"
              ]
              <| do
                Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
                  <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)")
          if null readyTasks
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work."
            else
              Lucid.div_ [Lucid.class_ "list-group"]
                <| traverse_ renderListGroupItem (take 5 readyTasks)

          Lucid.h2_ "Recent Activity"
          Lucid.div_
            [ Lucid.class_ "recent-activity",
              Lucid.makeAttribute "hx-get" "/partials/recent-activity",
              Lucid.makeAttribute "hx-trigger" "every 10s"
            ]
            <| do
              if null recentTasks
                then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks."
                else
                  Lucid.div_ [Lucid.class_ "list-group"]
                    <| traverse_ renderListGroupItem recentTasks
              when hasMoreRecent
                <| Lucid.button_
                  [ Lucid.class_ "btn btn-secondary load-more-btn",
                    Lucid.makeAttribute "hx-get" "/partials/recent-activity?offset=5",
                    Lucid.makeAttribute "hx-target" "closest .recent-activity",
                    Lucid.makeAttribute "hx-swap" "beforeend"
                  ]
                  "Load More"
    where
      statCard :: (Monad m) => Text -> Int -> Text -> Text -> Lucid.HtmlT m ()
      statCard label count badgeClass href =
        Lucid.a_ [Lucid.href_ href, Lucid.class_ ("stat-card " <> badgeClass)] <| do
          Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
          Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)

instance Lucid.ToHtml ReadyQueuePage where
  toHtmlRaw = Lucid.toHtml
  toHtml (ReadyQueuePage tasks _now) =
    Lucid.doctypehtml_ <| do
      pageHead "Ready Queue - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml ("Ready Queue (" <> tshow (length tasks) <> " tasks)")
          if null tasks
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks are ready for work."
            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks

instance Lucid.ToHtml BlockedPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (BlockedPage tasks _now) =
    Lucid.doctypehtml_ <| do
      pageHead "Blocked Tasks - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasks) <> " tasks)")
          Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies."
          if null tasks
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks

instance Lucid.ToHtml InterventionPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (InterventionPage tasks _now) =
    Lucid.doctypehtml_ <| do
      pageHead "Needs Intervention - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml ("Needs Intervention (" <> tshow (length tasks) <> " tasks)")
          Lucid.p_ [Lucid.class_ "info-msg"] "Tasks that have failed 3+ times and need human help."
          if null tasks
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks need intervention."
            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard tasks

instance Lucid.ToHtml KBPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (KBPage facts) =
    Lucid.doctypehtml_ <| do
      pageHead "Knowledge Base - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Knowledge Base"
          Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution."

          Lucid.details_ [Lucid.class_ "create-fact-section"] <| do
            Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact"
            Lucid.form_
              [ Lucid.method_ "POST",
                Lucid.action_ "/kb/create",
                Lucid.class_ "fact-create-form"
              ]
              <| do
                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "project"] "Project:"
                  Lucid.input_
                    [ Lucid.type_ "text",
                      Lucid.name_ "project",
                      Lucid.id_ "project",
                      Lucid.class_ "form-input",
                      Lucid.required_ "required",
                      Lucid.placeholder_ "e.g., Omni/Jr"
                    ]
                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
                  Lucid.textarea_
                    [ Lucid.name_ "content",
                      Lucid.id_ "content",
                      Lucid.class_ "form-textarea",
                      Lucid.rows_ "4",
                      Lucid.required_ "required",
                      Lucid.placeholder_ "Describe the fact or knowledge..."
                    ]
                    ""
                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
                  Lucid.input_
                    [ Lucid.type_ "text",
                      Lucid.name_ "files",
                      Lucid.id_ "files",
                      Lucid.class_ "form-input",
                      Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs"
                    ]
                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
                  Lucid.input_
                    [ Lucid.type_ "number",
                      Lucid.name_ "confidence",
                      Lucid.id_ "confidence",
                      Lucid.class_ "form-input",
                      Lucid.step_ "0.1",
                      Lucid.min_ "0",
                      Lucid.max_ "1",
                      Lucid.value_ "0.8"
                    ]
                Lucid.div_ [Lucid.class_ "form-actions"] <| do
                  Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact"

          if null facts
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No facts recorded yet."
            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderFactCard facts
    where
      renderFactCard :: (Monad m) => TaskCore.Fact -> Lucid.HtmlT m ()
      renderFactCard f =
        let factUrl = "/kb/" <> maybe "-" tshow (TaskCore.factId f)
         in Lucid.a_
              [ Lucid.class_ "task-card task-card-link",
                Lucid.href_ factUrl
              ]
              <| do
                Lucid.div_ [Lucid.class_ "task-header"] <| do
                  Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (maybe "-" tshow (TaskCore.factId f)))
                  confidenceBadge (TaskCore.factConfidence f)
                  Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (TaskCore.factProject f))
                Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (Text.take 80 (TaskCore.factContent f) <> if Text.length (TaskCore.factContent f) > 80 then "..." else ""))
                unless (null (TaskCore.factRelatedFiles f)) <| do
                  Lucid.p_ [Lucid.class_ "kb-files"] <| do
                    Lucid.span_ [Lucid.class_ "files-label"] "Files: "
                    Lucid.toHtml (Text.intercalate ", " (take 3 (TaskCore.factRelatedFiles f)))
                    when (length (TaskCore.factRelatedFiles f) > 3) <| do
                      Lucid.toHtml (" +" <> tshow (length (TaskCore.factRelatedFiles f) - 3) <> " more")

      confidenceBadge :: (Monad m) => Double -> Lucid.HtmlT m ()
      confidenceBadge conf =
        let pct = floor (conf * 100) :: Int
            cls
              | conf >= 0.8 = "badge badge-done"
              | conf >= 0.5 = "badge badge-inprogress"
              | otherwise = "badge badge-open"
         in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))

instance Lucid.ToHtml FactDetailPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (FactDetailNotFound fid) =
    Lucid.doctypehtml_ <| do
      pageHead "Fact Not Found - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Fact Not Found"
          Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found."))
          Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base"
  toHtml (FactDetailFound fact now) =
    Lucid.doctypehtml_ <| do
      pageHead "Fact Detail - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.div_ [Lucid.class_ "task-detail-header"] <| do
            Lucid.h1_ <| do
              Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact)))
            Lucid.div_ [Lucid.class_ "task-meta-row"] <| do
              Lucid.span_ [Lucid.class_ "meta-label"] "Project:"
              Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact))
              Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:"
              confidenceBadgeDetail (TaskCore.factConfidence fact)
              Lucid.span_ [Lucid.class_ "meta-label"] "Created:"
              Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact))

          Lucid.div_ [Lucid.class_ "detail-section"] <| do
            Lucid.h2_ "Content"
            Lucid.form_
              [ Lucid.method_ "POST",
                Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/edit"),
                Lucid.class_ "fact-edit-form"
              ]
              <| do
                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
                  Lucid.textarea_
                    [ Lucid.name_ "content",
                      Lucid.id_ "content",
                      Lucid.class_ "form-textarea",
                      Lucid.rows_ "6"
                    ]
                    (Lucid.toHtml (TaskCore.factContent fact))

                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
                  Lucid.input_
                    [ Lucid.type_ "text",
                      Lucid.name_ "files",
                      Lucid.id_ "files",
                      Lucid.class_ "form-input",
                      Lucid.value_ (Text.intercalate ", " (TaskCore.factRelatedFiles fact))
                    ]

                Lucid.div_ [Lucid.class_ "form-group"] <| do
                  Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
                  Lucid.input_
                    [ Lucid.type_ "number",
                      Lucid.name_ "confidence",
                      Lucid.id_ "confidence",
                      Lucid.class_ "form-input",
                      Lucid.step_ "0.1",
                      Lucid.min_ "0",
                      Lucid.max_ "1",
                      Lucid.value_ (tshow (TaskCore.factConfidence fact))
                    ]

                Lucid.div_ [Lucid.class_ "form-actions"] <| do
                  Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save Changes"

          case TaskCore.factSourceTask fact of
            Nothing -> pure ()
            Just tid -> do
              Lucid.div_ [Lucid.class_ "detail-section"] <| do
                Lucid.h2_ "Source Task"
                Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "task-link"] (Lucid.toHtml tid)

          Lucid.div_ [Lucid.class_ "detail-section danger-zone"] <| do
            Lucid.h2_ "Danger Zone"
            Lucid.form_
              [ Lucid.method_ "POST",
                Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/delete"),
                Lucid.class_ "delete-form",
                Lucid.makeAttribute "onsubmit" "return confirm('Are you sure you want to delete this fact?');"
              ]
              <| do
                Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-danger"] "Delete Fact"

          Lucid.div_ [Lucid.class_ "back-link"] <| do
            Lucid.a_ [Lucid.href_ "/kb"] "← Back to Knowledge Base"
    where
      confidenceBadgeDetail :: (Monad m) => Double -> Lucid.HtmlT m ()
      confidenceBadgeDetail conf =
        let pct = floor (conf * 100) :: Int
            cls
              | conf >= 0.8 = "badge badge-done"
              | conf >= 0.5 = "badge badge-inprogress"
              | otherwise = "badge badge-open"
         in Lucid.span_ [Lucid.class_ cls] (Lucid.toHtml (tshow pct <> "%"))

instance Lucid.ToHtml EpicsPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (EpicsPage epics allTasks) =
    Lucid.doctypehtml_ <| do
      pageHead "Epics - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")")
          Lucid.p_ [Lucid.class_ "info-msg"] "All epics (large, multi-task projects)."
          if null epics
            then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics found."
            else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ (renderEpicCardWithStats allTasks) epics

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)

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
          case TaskCore.taskDescription t of
            Nothing -> pure ()
            Just desc ->
              Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "..."))

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

instance Lucid.ToHtml TaskListPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskListPage tasks filters _now) =
    Lucid.doctypehtml_ <| do
      pageHead "Tasks - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")")

          Lucid.div_ [Lucid.class_ "filter-form"] <| do
            Lucid.form_
              [ Lucid.method_ "GET",
                Lucid.action_ "/tasks",
                Lucid.makeAttribute "hx-get" "/partials/task-list",
                Lucid.makeAttribute "hx-target" "#task-list",
                Lucid.makeAttribute "hx-push-url" "/tasks",
                Lucid.makeAttribute "hx-trigger" "submit, change from:select"
              ]
              <| do
                Lucid.div_ [Lucid.class_ "filter-row"] <| do
                  Lucid.div_ [Lucid.class_ "filter-group"] <| do
                    Lucid.label_ [Lucid.for_ "status"] "Status:"
                    Lucid.select_ [Lucid.name_ "status", Lucid.id_ "status", Lucid.class_ "filter-select"] <| do
                      Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterStatus filters)) "All"
                      statusFilterOption TaskCore.Open (filterStatus filters)
                      statusFilterOption TaskCore.InProgress (filterStatus filters)
                      statusFilterOption TaskCore.Review (filterStatus filters)
                      statusFilterOption TaskCore.Approved (filterStatus filters)
                      statusFilterOption TaskCore.Done (filterStatus filters)

                  Lucid.div_ [Lucid.class_ "filter-group"] <| do
                    Lucid.label_ [Lucid.for_ "priority"] "Priority:"
                    Lucid.select_ [Lucid.name_ "priority", Lucid.id_ "priority", Lucid.class_ "filter-select"] <| do
                      Lucid.option_ ([Lucid.value_ ""] <> maybeSelected Nothing (filterPriority filters)) "All"
                      priorityFilterOption TaskCore.P0 (filterPriority filters)
                      priorityFilterOption TaskCore.P1 (filterPriority filters)
                      priorityFilterOption TaskCore.P2 (filterPriority filters)
                      priorityFilterOption TaskCore.P3 (filterPriority filters)
                      priorityFilterOption TaskCore.P4 (filterPriority filters)

                  Lucid.div_ [Lucid.class_ "filter-group"] <| do
                    Lucid.label_ [Lucid.for_ "namespace"] "Namespace:"
                    Lucid.input_
                      [ Lucid.type_ "text",
                        Lucid.name_ "namespace",
                        Lucid.id_ "namespace",
                        Lucid.class_ "filter-input",
                        Lucid.placeholder_ "e.g. Omni/Jr",
                        Lucid.value_ (fromMaybe "" (filterNamespace filters))
                      ]

                  Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
                  Lucid.a_
                    [ Lucid.href_ "/tasks",
                      Lucid.class_ "clear-btn",
                      Lucid.makeAttribute "hx-get" "/partials/task-list",
                      Lucid.makeAttribute "hx-target" "#task-list",
                      Lucid.makeAttribute "hx-push-url" "/tasks"
                    ]
                    "Clear"

          Lucid.div_ [Lucid.id_ "task-list"] <| do
            if null tasks
              then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
              else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
    where
      maybeSelected :: (Eq a) => Maybe a -> Maybe a -> [Lucid.Attribute]
      maybeSelected opt current = [Lucid.selected_ "selected" | opt == current]

      statusFilterOption :: (Monad m) => TaskCore.Status -> Maybe TaskCore.Status -> Lucid.HtmlT m ()
      statusFilterOption s current =
        let attrs = [Lucid.value_ (tshow s)] <> [Lucid.selected_ "selected" | Just s == current]
         in Lucid.option_ attrs (Lucid.toHtml (tshow s))

      priorityFilterOption :: (Monad m) => TaskCore.Priority -> Maybe TaskCore.Priority -> Lucid.HtmlT m ()
      priorityFilterOption p current =
        let attrs = [Lucid.value_ (tshow p)] <> [Lucid.selected_ "selected" | Just p == current]
         in Lucid.option_ attrs (Lucid.toHtml (tshow p))

instance Lucid.ToHtml TaskDetailPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskDetailNotFound tid) =
    Lucid.doctypehtml_ <| do
      pageHead "Task Not Found - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Task Not Found"
          Lucid.p_ <| do
            "The task "
            Lucid.code_ (Lucid.toHtml tid)
            " could not be found."
  toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics now) =
    Lucid.doctypehtml_ <| do
      pageHead (TaskCore.taskId task <> " - Jr")
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)

          renderRetryContextBanner (TaskCore.taskId task) maybeRetry

          Lucid.div_ [Lucid.class_ "task-detail"] <| do
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
              Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))

            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Type:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskType task)))

            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
              Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)

            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Priority:"
              Lucid.span_ [Lucid.class_ "detail-value"] <| do
                Lucid.toHtml (tshow (TaskCore.taskPriority task))
                Lucid.span_ [Lucid.class_ "priority-desc"] (Lucid.toHtml (priorityDesc (TaskCore.taskPriority task)))

            case TaskCore.taskNamespace task of
              Nothing -> pure ()
              Just ns ->
                Lucid.div_ [Lucid.class_ "detail-row"] <| do
                  Lucid.span_ [Lucid.class_ "detail-label"] "Namespace:"
                  Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml ns)

            case TaskCore.taskParent task of
              Nothing -> pure ()
              Just pid ->
                Lucid.div_ [Lucid.class_ "detail-row"] <| do
                  Lucid.span_ [Lucid.class_ "detail-label"] "Parent:"
                  Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "detail-value task-link"] (Lucid.toHtml pid)

            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Created:"
              Lucid.span_ [Lucid.class_ "detail-value"] (renderRelativeTimestamp now (TaskCore.taskCreatedAt task))

            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Updated:"
              Lucid.span_ [Lucid.class_ "detail-value"] (renderRelativeTimestamp now (TaskCore.taskUpdatedAt task))

            let deps = TaskCore.taskDependencies task
            unless (null deps) <| do
              Lucid.div_ [Lucid.class_ "detail-section"] <| do
                Lucid.h3_ "Dependencies"
                Lucid.ul_ [Lucid.class_ "dep-list"] <| do
                  traverse_ renderDependency deps

            case TaskCore.taskType task of
              TaskCore.Epic -> do
                for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
                Lucid.div_ [Lucid.class_ "detail-section"] <| do
                  Lucid.h3_ "Design"
                  case TaskCore.taskDescription task of
                    Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
                    Just desc -> Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown desc)
                  Lucid.details_ [Lucid.class_ "edit-description"] <| do
                    Lucid.summary_ "Edit Design"
                    Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description")] <| do
                      Lucid.textarea_
                        [ Lucid.name_ "description",
                          Lucid.class_ "description-textarea",
                          Lucid.rows_ "15",
                          Lucid.placeholder_ "Enter design in Markdown format..."
                        ]
                        (Lucid.toHtml (fromMaybe "" (TaskCore.taskDescription task)))
                      Lucid.div_ [Lucid.class_ "form-actions"] <| do
                        Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Design"
              _ ->
                case TaskCore.taskDescription task of
                  Nothing -> pure ()
                  Just desc ->
                    Lucid.div_ [Lucid.class_ "detail-section"] <| do
                      Lucid.h3_ "Description"
                      Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc)

            let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks
            unless (null children) <| do
              Lucid.div_ [Lucid.class_ "detail-section"] <| do
                Lucid.h3_ "Child Tasks"
                Lucid.ul_ [Lucid.class_ "child-list"] <| do
                  traverse_ renderChild children

            unless (null commits) <| do
              Lucid.div_ [Lucid.class_ "detail-section"] <| do
                Lucid.h3_ "Git Commits"
                Lucid.div_ [Lucid.class_ "commit-list"] <| do
                  traverse_ (renderCommit (TaskCore.taskId task)) commits

          let hasRunningActivity = any (\a -> TaskCore.activityStage a == TaskCore.Running) activities
          when hasRunningActivity <| do
            let isInProgress = TaskCore.taskStatus task == TaskCore.InProgress
                htmxAttrs =
                  [ Lucid.makeAttribute "hx-get" ("/partials/task/" <> TaskCore.taskId task <> "/metrics"),
                    Lucid.makeAttribute "hx-trigger" "every 5s",
                    Lucid.makeAttribute "hx-swap" "innerHTML"
                  ]
                sectionAttrs =
                  [Lucid.class_ "execution-section", Lucid.id_ "execution-details"]
                    <> [attr | isInProgress, attr <- htmxAttrs]
            Lucid.div_ sectionAttrs <| do
              Lucid.h3_ "Execution Details"
              renderExecutionDetails (TaskCore.taskId task) activities maybeRetry

          when (TaskCore.taskStatus task == TaskCore.InProgress && not (null activities)) <| do
            Lucid.div_ [Lucid.class_ "activity-section"] <| do
              Lucid.h3_ "Activity Timeline"
              Lucid.div_ [Lucid.class_ "activity-timeline"] <| do
                traverse_ renderActivity activities

          when (TaskCore.taskStatus task == TaskCore.Review) <| do
            Lucid.div_ [Lucid.class_ "review-link-section"] <| do
              Lucid.a_
                [ Lucid.href_ ("/tasks/" <> TaskCore.taskId task <> "/review"),
                  Lucid.class_ "review-link-btn"
                ]
                "Review This Task"
    where
      priorityDesc :: TaskCore.Priority -> Text
      priorityDesc p = case p of
        TaskCore.P0 -> " (Critical)"
        TaskCore.P1 -> " (High)"
        TaskCore.P2 -> " (Medium)"
        TaskCore.P3 -> " (Low)"
        TaskCore.P4 -> " (Backlog)"

      renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
      renderDependency dep =
        Lucid.li_ <| do
          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep))
          Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]")

      renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
      renderChild child =
        Lucid.li_ <| do
          Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child))
          Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child)
          Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]")

      renderCommit :: (Monad m) => Text -> GitCommit -> Lucid.HtmlT m ()
      renderCommit tid c =
        Lucid.div_ [Lucid.class_ "commit-item"] <| do
          Lucid.div_ [Lucid.class_ "commit-header"] <| do
            Lucid.a_
              [ Lucid.href_ ("/tasks/" <> tid <> "/diff/" <> commitHash c),
                Lucid.class_ "commit-hash"
              ]
              (Lucid.toHtml (commitShortHash c))
            Lucid.span_ [Lucid.class_ "commit-summary"] (Lucid.toHtml (commitSummary c))
          Lucid.div_ [Lucid.class_ "commit-meta"] <| do
            Lucid.span_ [Lucid.class_ "commit-author"] (Lucid.toHtml (commitAuthor c))
            Lucid.span_ [Lucid.class_ "commit-date"] (Lucid.toHtml (commitRelativeDate c))
            Lucid.span_ [Lucid.class_ "commit-files"] (Lucid.toHtml (tshow (commitFilesChanged c) <> " files"))

      renderActivity :: (Monad m) => TaskCore.TaskActivity -> Lucid.HtmlT m ()
      renderActivity act =
        Lucid.div_ [Lucid.class_ ("activity-item " <> stageClass (TaskCore.activityStage act))] <| do
          Lucid.div_ [Lucid.class_ "activity-icon"] (stageIcon (TaskCore.activityStage act))
          Lucid.div_ [Lucid.class_ "activity-content"] <| do
            Lucid.div_ [Lucid.class_ "activity-header"] <| do
              Lucid.span_ [Lucid.class_ "activity-stage"] (Lucid.toHtml (tshow (TaskCore.activityStage act)))
              Lucid.span_ [Lucid.class_ "activity-time"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act))
            case TaskCore.activityMessage act of
              Nothing -> pure ()
              Just msg -> Lucid.p_ [Lucid.class_ "activity-message"] (Lucid.toHtml msg)
            case TaskCore.activityMetadata act of
              Nothing -> pure ()
              Just meta ->
                Lucid.details_ [Lucid.class_ "activity-metadata"] <| do
                  Lucid.summary_ "Metadata"
                  Lucid.pre_ [Lucid.class_ "metadata-json"] (Lucid.toHtml meta)

      stageClass :: TaskCore.ActivityStage -> Text
      stageClass stage = case stage of
        TaskCore.Claiming -> "stage-claiming"
        TaskCore.Running -> "stage-running"
        TaskCore.Reviewing -> "stage-reviewing"
        TaskCore.Retrying -> "stage-retrying"
        TaskCore.Completed -> "stage-completed"
        TaskCore.Failed -> "stage-failed"

      stageIcon :: (Monad m) => TaskCore.ActivityStage -> Lucid.HtmlT m ()
      stageIcon stage = case stage of
        TaskCore.Claiming -> "●"
        TaskCore.Running -> "▶"
        TaskCore.Reviewing -> "◎"
        TaskCore.Retrying -> "↻"
        TaskCore.Completed -> "✓"
        TaskCore.Failed -> "✗"

      renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m ()
      renderExecutionDetails _ acts retryCtx =
        let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) acts
         in if null runningActs
              then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
              else
                Lucid.div_ [Lucid.class_ "execution-details"] <| do
                  let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
                      totalDuration = sum [calcDurSecs act | act <- runningActs]
                      attemptCount = length runningActs

                  case retryCtx of
                    Nothing -> pure ()
                    Just ctx ->
                      Lucid.div_ [Lucid.class_ "metric-row"] <| do
                        Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
                        Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))

                  when (attemptCount > 1) <| do
                    Lucid.div_ [Lucid.class_ "metric-row"] <| do
                      Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
                      Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
                    Lucid.div_ [Lucid.class_ "metric-row"] <| do
                      Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
                      Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
                    when (totalCost > 0)
                      <| Lucid.div_ [Lucid.class_ "metric-row"]
                      <| do
                        Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
                        Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal totalCost))
                    Lucid.hr_ [Lucid.class_ "attempts-divider"]

                  traverse_ (renderAttempt attemptCount) (zip [1 ..] (reverse runningActs))
        where
          calcDurSecs :: TaskCore.TaskActivity -> Int
          calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
            (Just start, Just end) -> floor (diffUTCTime end start)
            _ -> 0

          formatDurSecs :: Int -> Text
          formatDurSecs secs
            | secs < 60 = tshow secs <> "s"
            | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
            | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"

          renderAttempt :: (Monad m) => Int -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
          renderAttempt totalAttempts (attemptNum, act) = do
            when (totalAttempts > 1)
              <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
            case TaskCore.activityAmpThreadUrl act of
              Nothing -> pure ()
              Just url ->
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:"
                  Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"

            case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
              (Just start, Just end) ->
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
                  Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDur start end))
              (Just start, Nothing) ->
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
                  Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now start)
              _ -> pure ()

            case TaskCore.activityCostCents act of
              Nothing -> pure ()
              Just cents ->
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
                  Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCostVal cents))

            Lucid.div_ [Lucid.class_ "metric-row"] <| do
              Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
              Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act))

          formatDur :: UTCTime -> UTCTime -> Text
          formatDur start end =
            let diffSecs = floor (diffUTCTime end start) :: Int
                mins = diffSecs `div` 60
                secs = diffSecs `mod` 60
             in if mins > 0
                  then tshow mins <> "m " <> tshow secs <> "s"
                  else tshow secs <> "s"

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

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 (formatCost costCents))
            Lucid.div_ [Lucid.class_ "metric-label"] "Total Cost"
          Lucid.div_ [Lucid.class_ "metric-card"] <| do
            Lucid.div_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration 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 (formatTokens tokensUsed))
              Lucid.div_ [Lucid.class_ "metric-label"] "Tokens Used"
  where
    formatCost :: Int -> Text
    formatCost cents =
      let dollars = fromIntegral cents / 100.0 :: Double
       in "$" <> Text.pack (showFFloat (Just 2) dollars "")

    formatDuration :: Int -> Text
    formatDuration 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"

    formatTokens :: Int -> Text
    formatTokens 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"

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.div_ [Lucid.class_ "retry-notes-section"] <| do
        Lucid.h4_ "Human Notes/Guidance"
        Lucid.p_ [Lucid.class_ "notes-help"] "Add notes to guide the worker on the next retry attempt:"
        Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> tid <> "/notes")] <| do
          Lucid.textarea_
            [ Lucid.name_ "notes",
              Lucid.class_ "notes-textarea",
              Lucid.rows_ "6",
              Lucid.placeholder_ "Provide guidance for the worker: what to fix, which approach to use, or what to avoid..."
            ]
            (Lucid.toHtml (fromMaybe "" (TaskCore.retryNotes ctx)))
          Lucid.div_ [Lucid.class_ "form-actions"] <| do
            Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Notes"

      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"

    case TaskCore.retryNotes ctx of
      Nothing -> pure ()
      Just notes ->
        unless maxRetriesExceeded <| do
          Lucid.div_ [Lucid.class_ "retry-notes-display"] <| do
            Lucid.h4_ "Human Notes"
            Lucid.div_ [Lucid.class_ "notes-content"] (Lucid.toHtml notes)
  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 ""

instance Lucid.ToHtml TaskReviewPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (ReviewPageNotFound tid) =
    Lucid.doctypehtml_ <| do
      pageHead "Task Not Found - Jr Review"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Task Not Found"
          Lucid.p_ <| do
            "The task "
            Lucid.code_ (Lucid.toHtml tid)
            " could not be found."
  toHtml (ReviewPageFound task reviewInfo) =
    Lucid.doctypehtml_ <| do
      pageHead ("Review: " <> TaskCore.taskId task <> " - Jr")
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Review Task"

          Lucid.div_ [Lucid.class_ "task-summary"] <| do
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
              Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
              Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)

          case reviewInfo of
            ReviewNoCommit ->
              Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
                Lucid.h3_ "No Commit Found"
                Lucid.p_ "No commit with this task ID was found in the git history."
                Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
            ReviewMergeConflict commitSha conflictFiles ->
              Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
                Lucid.h3_ "Merge Conflict Detected"
                Lucid.p_ <| do
                  "Commit "
                  Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
                  " cannot be cleanly merged."
                Lucid.p_ "Conflicting files:"
                Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
            ReviewReady commitSha diffText -> do
              Lucid.div_ [Lucid.class_ "diff-section"] <| do
                Lucid.h3_ <| do
                  "Commit: "
                  Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
                Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)

              Lucid.div_ [Lucid.class_ "review-actions"] <| do
                Lucid.form_
                  [ Lucid.method_ "POST",
                    Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
                    Lucid.class_ "inline-form"
                  ]
                  <| do
                    Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"

                Lucid.form_
                  [ Lucid.method_ "POST",
                    Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
                    Lucid.class_ "reject-form"
                  ]
                  <| do
                    Lucid.textarea_
                      [ Lucid.name_ "notes",
                        Lucid.class_ "reject-notes",
                        Lucid.placeholder_ "Rejection notes (optional)"
                      ]
                      ""
                    Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject"

instance Lucid.ToHtml TaskDiffPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (DiffPageNotFound tid commitHash') =
    Lucid.doctypehtml_ <| do
      pageHead "Commit Not Found - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ "Commit Not Found"
          Lucid.p_ <| do
            "Could not find commit "
            Lucid.code_ (Lucid.toHtml commitHash')
          Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
  toHtml (DiffPageFound tid commitHash' diffOutput) =
    Lucid.doctypehtml_ <| do
      pageHead ("Diff " <> Text.take 8 commitHash' <> " - Jr")
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.div_ [Lucid.class_ "diff-header"] <| do
            Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
            Lucid.h1_ <| do
              "Commit "
              Lucid.code_ (Lucid.toHtml (Text.take 8 commitHash'))
          Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput)

instance Lucid.ToHtml StatsPage where
  toHtmlRaw = Lucid.toHtml
  toHtml (StatsPage stats maybeEpic) =
    Lucid.doctypehtml_ <| do
      pageHead "Task Statistics - Jr"
      Lucid.body_ <| do
        navbar
        Lucid.div_ [Lucid.class_ "container"] <| do
          Lucid.h1_ <| case maybeEpic of
            Nothing -> "Task Statistics"
            Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId)

          Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do
            Lucid.div_ [Lucid.class_ "filter-row"] <| do
              Lucid.div_ [Lucid.class_ "filter-group"] <| do
                Lucid.label_ [Lucid.for_ "epic"] "Epic:"
                Lucid.input_
                  [ Lucid.type_ "text",
                    Lucid.name_ "epic",
                    Lucid.id_ "epic",
                    Lucid.class_ "filter-input",
                    Lucid.placeholder_ "Epic ID (optional)",
                    Lucid.value_ (fromMaybe "" maybeEpic)
                  ]
              Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
              Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear"

          Lucid.h2_ "By Status"
          multiColorProgressBar stats
          Lucid.div_ [Lucid.class_ "stats-grid"] <| do
            statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats)
            statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats)
            statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats)
            statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats)
            statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats)

          Lucid.h2_ "By Priority"
          Lucid.div_ [Lucid.class_ "stats-section"] <| do
            traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats)

          Lucid.h2_ "By Namespace"
          Lucid.div_ [Lucid.class_ "stats-section"] <| do
            if null (TaskCore.tasksByNamespace stats)
              then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found."
              else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats)

          Lucid.h2_ "Summary"
          Lucid.div_ [Lucid.class_ "summary-section"] <| do
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats)))
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Epics:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats)))
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Ready:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats)))
            Lucid.div_ [Lucid.class_ "detail-row"] <| do
              Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:"
              Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats)))
    where
      statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m ()
      statCard label count total =
        let pct = if total == 0 then 0 else (count * 100) `div` total
         in Lucid.div_ [Lucid.class_ "stat-card"] <| do
              Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count))
              Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label)
              Lucid.div_ [Lucid.class_ "progress-bar"] <| do
                Lucid.div_
                  [ Lucid.class_ "progress-fill",
                    Lucid.style_ ("width: " <> tshow pct <> "%")
                  ]
                  ""

      renderPriorityRow :: (Monad m) => TaskCore.Priority -> Int -> Lucid.HtmlT m ()
      renderPriorityRow priority count =
        let total = TaskCore.totalTasks stats
            pct = if total == 0 then 0 else (count * 100) `div` total
         in Lucid.div_ [Lucid.class_ "stats-row"] <| do
              Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml (tshow priority))
              Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
                Lucid.div_ [Lucid.class_ "progress-bar"] <| do
                  Lucid.div_
                    [ Lucid.class_ "progress-fill",
                      Lucid.style_ ("width: " <> tshow pct <> "%")
                    ]
                    ""
              Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))

      renderNamespaceRow :: (Monad m) => Int -> Text -> Int -> Lucid.HtmlT m ()
      renderNamespaceRow total ns count =
        let pct = if total == 0 then 0 else (count * 100) `div` total
         in Lucid.div_ [Lucid.class_ "stats-row"] <| do
              Lucid.span_ [Lucid.class_ "stats-label"] (Lucid.toHtml ns)
              Lucid.div_ [Lucid.class_ "stats-bar-container"] <| do
                Lucid.div_ [Lucid.class_ "progress-bar"] <| do
                  Lucid.div_
                    [ Lucid.class_ "progress-fill",
                      Lucid.style_ ("width: " <> tshow pct <> "%")
                    ]
                    ""
              Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count))

instance Lucid.ToHtml RecentActivityPartial where
  toHtmlRaw = Lucid.toHtml
  toHtml (RecentActivityPartial recentTasks nextOffset hasMore _now) =
    if null recentTasks
      then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks."
      else do
        Lucid.div_ [Lucid.class_ "list-group"]
          <| traverse_ renderListGroupItem recentTasks
        when hasMore
          <| Lucid.button_
            [ Lucid.class_ "btn btn-secondary load-more-btn",
              Lucid.makeAttribute "hx-get" ("/partials/recent-activity?offset=" <> tshow nextOffset),
              Lucid.makeAttribute "hx-target" "closest .recent-activity",
              Lucid.makeAttribute "hx-swap" "beforeend"
            ]
            "Load More"

instance Lucid.ToHtml ReadyCountPartial where
  toHtmlRaw = Lucid.toHtml
  toHtml (ReadyCountPartial count) =
    Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"]
      <| Lucid.toHtml ("(" <> tshow count <> " tasks)")

instance Lucid.ToHtml StatusBadgePartial where
  toHtmlRaw = Lucid.toHtml
  toHtml (StatusBadgePartial status tid) =
    statusBadgeWithForm status tid

instance Lucid.ToHtml TaskListPartial where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskListPartial tasks) =
    if null tasks
      then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
      else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks

instance Lucid.ToHtml TaskMetricsPartial where
  toHtmlRaw = Lucid.toHtml
  toHtml (TaskMetricsPartial _tid activities maybeRetry now) =
    let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities
     in if null runningActs
          then Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available."
          else
            Lucid.div_ [Lucid.class_ "execution-details"] <| do
              let totalCost = sum [c | act <- runningActs, Just c <- [TaskCore.activityCostCents act]]
                  totalDuration = sum [calcDurSecs act | act <- runningActs]
                  attemptCount = length runningActs

              case maybeRetry of
                Nothing -> pure ()
                Just ctx ->
                  Lucid.div_ [Lucid.class_ "metric-row"] <| do
                    Lucid.span_ [Lucid.class_ "metric-label"] "Retry Attempt:"
                    Lucid.span_ [Lucid.class_ "metric-value retry-count"] (Lucid.toHtml (tshow (TaskCore.retryAttempt ctx) <> "/3"))

              when (attemptCount > 1) <| do
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Total Attempts:"
                  Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (tshow attemptCount))
                Lucid.div_ [Lucid.class_ "metric-row"] <| do
                  Lucid.span_ [Lucid.class_ "metric-label"] "Total Duration:"
                  Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDurSecs totalDuration))
                when (totalCost > 0)
                  <| Lucid.div_ [Lucid.class_ "metric-row"]
                  <| do
                    Lucid.span_ [Lucid.class_ "metric-label"] "Total Cost:"
                    Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost totalCost))
                Lucid.hr_ [Lucid.class_ "attempts-divider"]

              traverse_ (renderAttempt attemptCount now) (zip [1 ..] (reverse runningActs))
    where
      calcDurSecs :: TaskCore.TaskActivity -> Int
      calcDurSecs act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
        (Just start, Just end) -> floor (diffUTCTime end start)
        _ -> 0

      formatDurSecs :: Int -> Text
      formatDurSecs secs
        | secs < 60 = tshow secs <> "s"
        | secs < 3600 = tshow (secs `div` 60) <> "m " <> tshow (secs `mod` 60) <> "s"
        | otherwise = tshow (secs `div` 3600) <> "h " <> tshow ((secs `mod` 3600) `div` 60) <> "m"

      renderAttempt :: (Monad m) => Int -> UTCTime -> (Int, TaskCore.TaskActivity) -> Lucid.HtmlT m ()
      renderAttempt totalAttempts currentTime (attemptNum, act) = do
        when (totalAttempts > 1)
          <| Lucid.div_ [Lucid.class_ "attempt-header"] (Lucid.toHtml ("Attempt " <> tshow attemptNum :: Text))
        case TaskCore.activityAmpThreadUrl act of
          Nothing -> pure ()
          Just url ->
            Lucid.div_ [Lucid.class_ "metric-row"] <| do
              Lucid.span_ [Lucid.class_ "metric-label"] "Amp Thread:"
              Lucid.a_ [Lucid.href_ url, Lucid.target_ "_blank", Lucid.class_ "amp-thread-btn"] "View in Amp ↗"

        case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of
          (Just start, Just end) ->
            Lucid.div_ [Lucid.class_ "metric-row"] <| do
              Lucid.span_ [Lucid.class_ "metric-label"] "Duration:"
              Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatDuration start end))
          (Just start, Nothing) ->
            Lucid.div_ [Lucid.class_ "metric-row"] <| do
              Lucid.span_ [Lucid.class_ "metric-label"] "Started:"
              Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime start)
          _ -> pure ()

        case TaskCore.activityCostCents act of
          Nothing -> pure ()
          Just cents ->
            Lucid.div_ [Lucid.class_ "metric-row"] <| do
              Lucid.span_ [Lucid.class_ "metric-label"] "Cost:"
              Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatCost cents))

        Lucid.div_ [Lucid.class_ "metric-row"] <| do
          Lucid.span_ [Lucid.class_ "metric-label"] "Timestamp:"
          Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp currentTime (TaskCore.activityTimestamp act))

      formatDuration :: UTCTime -> UTCTime -> Text
      formatDuration start end =
        let diffSecs = floor (diffUTCTime end start) :: Int
            mins = diffSecs `div` 60
            secs = diffSecs `mod` 60
         in if mins > 0
              then tshow mins <> "m " <> tshow secs <> "s"
              else tshow secs <> "s"

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

-- | Simple markdown renderer for epic descriptions
-- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`)
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)

-- | Render inline markdown (backtick code, bold, italic)
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)

api :: Proxy API
api = Proxy

server :: Server API
server =
  homeHandler
    :<|> styleHandler
    :<|> readyQueueHandler
    :<|> blockedHandler
    :<|> interventionHandler
    :<|> statsHandler
    :<|> taskListHandler
    :<|> kbHandler
    :<|> factCreateHandler
    :<|> factDetailHandler
    :<|> factEditHandler
    :<|> factDeleteHandler
    :<|> epicsHandler
    :<|> taskDetailHandler
    :<|> taskStatusHandler
    :<|> taskDescriptionHandler
    :<|> taskNotesHandler
    :<|> taskReviewHandler
    :<|> taskDiffHandler
    :<|> taskAcceptHandler
    :<|> taskRejectHandler
    :<|> taskResetRetriesHandler
    :<|> recentActivityHandler
    :<|> readyCountHandler
    :<|> taskListPartialHandler
    :<|> taskMetricsPartialHandler
  where
    styleHandler :: Servant.Handler LazyText.Text
    styleHandler = pure Style.css

    homeHandler :: Servant.Handler HomePage
    homeHandler = do
      now <- liftIO getCurrentTime
      stats <- liftIO <| TaskCore.getTaskStats Nothing
      readyTasks <- liftIO TaskCore.getReadyTasks
      allTasks <- liftIO TaskCore.loadTasks
      let sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
          recentTasks = take 5 sortedTasks
          hasMoreRecent = length allTasks > 5
      pure (HomePage stats readyTasks recentTasks hasMoreRecent now)

    readyQueueHandler :: Servant.Handler ReadyQueuePage
    readyQueueHandler = do
      now <- liftIO getCurrentTime
      readyTasks <- liftIO TaskCore.getReadyTasks
      let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) readyTasks
      pure (ReadyQueuePage sortedTasks now)

    blockedHandler :: Servant.Handler BlockedPage
    blockedHandler = do
      now <- liftIO getCurrentTime
      blockedTasks <- liftIO TaskCore.getBlockedTasks
      let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) blockedTasks
      pure (BlockedPage sortedTasks now)

    interventionHandler :: Servant.Handler InterventionPage
    interventionHandler = do
      now <- liftIO getCurrentTime
      interventionTasks <- liftIO TaskCore.getInterventionTasks
      let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) interventionTasks
      pure (InterventionPage sortedTasks now)

    statsHandler :: Maybe Text -> Servant.Handler StatsPage
    statsHandler maybeEpic = do
      let epicId = emptyToNothing maybeEpic
      stats <- liftIO <| TaskCore.getTaskStats epicId
      pure (StatsPage stats epicId)

    taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
    taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
      now <- liftIO getCurrentTime
      allTasks <- liftIO TaskCore.loadTasks
      let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
          maybePriority = parsePriority =<< emptyToNothing maybePriorityText
          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
          filteredTasks = applyFilters filters allTasks
      pure (TaskListPage filteredTasks filters now)

    kbHandler :: Servant.Handler KBPage
    kbHandler = do
      facts <- liftIO Fact.getAllFacts
      pure (KBPage facts)

    factCreateHandler :: FactCreateForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factCreateHandler (FactCreateForm project content filesText confText) = do
      let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
          confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
      fid <- liftIO (Fact.createFact project content files Nothing confidence)
      pure <| addHeader ("/kb/" <> tshow fid) NoContent

    factDetailHandler :: Int -> Servant.Handler FactDetailPage
    factDetailHandler fid = do
      now <- liftIO getCurrentTime
      maybeFact <- liftIO (Fact.getFact fid)
      case maybeFact of
        Nothing -> pure (FactDetailNotFound fid)
        Just fact -> pure (FactDetailFound fact now)

    factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factEditHandler fid (FactEditForm content filesText confText) = do
      let files = filter (not <. Text.null) (Text.splitOn "," (Text.strip filesText))
          confidence = fromMaybe 0.8 (readMaybe (Text.unpack confText))
      liftIO (Fact.updateFact fid content files confidence)
      pure <| addHeader ("/kb/" <> tshow fid) NoContent

    factDeleteHandler :: Int -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    factDeleteHandler fid = do
      liftIO (Fact.deleteFact fid)
      pure <| addHeader "/kb" NoContent

    epicsHandler :: Servant.Handler EpicsPage
    epicsHandler = do
      allTasks <- liftIO TaskCore.loadTasks
      let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
          sortedEpics = List.sortBy (compare `on` TaskCore.taskPriority) epicTasks
      pure (EpicsPage sortedEpics allTasks)

    parseStatus :: Text -> Maybe TaskCore.Status
    parseStatus = readMaybe <. Text.unpack

    parsePriority :: Text -> Maybe TaskCore.Priority
    parsePriority = readMaybe <. Text.unpack

    parseTaskType :: Text -> Maybe TaskCore.TaskType
    parseTaskType = readMaybe <. Text.unpack

    emptyToNothing :: Maybe Text -> Maybe Text
    emptyToNothing (Just t) | Text.null (Text.strip t) = Nothing
    emptyToNothing x = x

    applyFilters :: TaskFilters -> [TaskCore.Task] -> [TaskCore.Task]
    applyFilters filters = filter matchesAllFilters
      where
        matchesAllFilters task =
          matchesStatus task
            && matchesPriority task
            && matchesNamespace task
            && matchesType task

        matchesStatus task = case filterStatus filters of
          Nothing -> True
          Just s -> TaskCore.taskStatus task == s

        matchesPriority task = case filterPriority filters of
          Nothing -> True
          Just p -> TaskCore.taskPriority task == p

        matchesNamespace task = case filterNamespace filters of
          Nothing -> True
          Just ns -> case TaskCore.taskNamespace task of
            Nothing -> False
            Just taskNs -> ns `Text.isPrefixOf` taskNs

        matchesType task = case filterType filters of
          Nothing -> True
          Just t -> TaskCore.taskType task == t

    taskDetailHandler :: Text -> Servant.Handler TaskDetailPage
    taskDetailHandler tid = do
      now <- liftIO getCurrentTime
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (TaskDetailNotFound tid)
        Just task -> do
          activities <- liftIO (TaskCore.getActivitiesForTask tid)
          retryCtx <- liftIO (TaskCore.getRetryContext tid)
          commits <- liftIO (getCommitsForTask tid)
          aggMetrics <-
            if TaskCore.taskType task == TaskCore.Epic
              then Just </ liftIO (TaskCore.getAggregatedMetrics tid)
              else pure Nothing
          pure (TaskDetailFound task tasks activities retryCtx commits aggMetrics now)

    taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
    taskStatusHandler tid (StatusForm newStatus) = do
      liftIO <| TaskCore.updateTaskStatus tid newStatus []
      pure (StatusBadgePartial newStatus tid)

    taskDescriptionHandler :: Text -> DescriptionForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskDescriptionHandler tid (DescriptionForm desc) = do
      let descMaybe = if Text.null (Text.strip desc) then Nothing else Just desc
      _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descMaybe})
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskNotesHandler :: Text -> NotesForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskNotesHandler tid (NotesForm notes) = do
      liftIO <| TaskCore.updateRetryNotes tid notes
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskReviewHandler :: Text -> Servant.Handler TaskReviewPage
    taskReviewHandler tid = do
      tasks <- liftIO TaskCore.loadTasks
      case TaskCore.findTask tid tasks of
        Nothing -> pure (ReviewPageNotFound tid)
        Just task -> do
          reviewInfo <- liftIO <| getReviewInfo tid
          pure (ReviewPageFound task reviewInfo)

    taskDiffHandler :: Text -> Text -> Servant.Handler TaskDiffPage
    taskDiffHandler tid commitSha = do
      diffOutput <- liftIO <| getDiffForCommit commitSha
      case diffOutput of
        Nothing -> pure (DiffPageNotFound tid commitSha)
        Just output -> pure (DiffPageFound tid commitSha output)

    taskAcceptHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskAcceptHandler tid = do
      liftIO <| do
        TaskCore.clearRetryContext tid
        TaskCore.updateTaskStatus tid TaskCore.Done []
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskRejectHandler :: Text -> RejectForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskRejectHandler tid (RejectForm maybeNotes) = do
      liftIO <| do
        maybeCommit <- findCommitForTask tid
        let commitSha = fromMaybe "" maybeCommit
        maybeCtx <- TaskCore.getRetryContext tid
        let attempt = maybe 1 (\ctx -> TaskCore.retryAttempt ctx + 1) maybeCtx
        let currentReason = "attempt " <> tshow attempt <> ": rejected: " <> fromMaybe "(no notes)" maybeNotes
        let accumulatedReason = case maybeCtx of
              Nothing -> currentReason
              Just ctx -> TaskCore.retryReason ctx <> "\n" <> currentReason
        TaskCore.setRetryContext
          TaskCore.RetryContext
            { TaskCore.retryTaskId = tid,
              TaskCore.retryOriginalCommit = commitSha,
              TaskCore.retryConflictFiles = [],
              TaskCore.retryAttempt = attempt,
              TaskCore.retryReason = accumulatedReason,
              TaskCore.retryNotes = maybeCtx +> TaskCore.retryNotes
            }
        TaskCore.updateTaskStatus tid TaskCore.Open []
      pure <| addHeader ("/tasks/" <> tid) NoContent

    taskResetRetriesHandler :: Text -> Servant.Handler (Headers '[Header "Location" Text] NoContent)
    taskResetRetriesHandler tid = do
      liftIO <| do
        TaskCore.clearRetryContext tid
        TaskCore.updateTaskStatus tid TaskCore.Open []
      pure <| addHeader ("/tasks/" <> tid) NoContent

    recentActivityHandler :: Maybe Int -> Servant.Handler RecentActivityPartial
    recentActivityHandler maybeOffset = do
      now <- liftIO getCurrentTime
      allTasks <- liftIO TaskCore.loadTasks
      let offset = fromMaybe 0 maybeOffset
          pageSize = 5
          sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks
          pageTasks = take pageSize <| drop offset sortedTasks
          hasMore = length sortedTasks > offset + pageSize
          nextOffset = offset + pageSize
      pure (RecentActivityPartial pageTasks nextOffset hasMore now)

    readyCountHandler :: Servant.Handler ReadyCountPartial
    readyCountHandler = do
      readyTasks <- liftIO TaskCore.getReadyTasks
      pure (ReadyCountPartial (length readyTasks))

    taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
    taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
      allTasks <- liftIO TaskCore.loadTasks
      let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
          maybePriority = parsePriority =<< emptyToNothing maybePriorityText
          maybeType = parseTaskType =<< emptyToNothing maybeTypeText
          filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
          filteredTasks = applyFilters filters allTasks
      pure (TaskListPartial filteredTasks)

    taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
    taskMetricsPartialHandler tid = do
      now <- liftIO getCurrentTime
      activities <- liftIO (TaskCore.getActivitiesForTask tid)
      maybeRetry <- liftIO (TaskCore.getRetryContext tid)
      pure (TaskMetricsPartial tid activities maybeRetry now)

getReviewInfo :: Text -> IO ReviewInfo
getReviewInfo tid = do
  maybeCommit <- findCommitForTask tid
  case maybeCommit of
    Nothing -> pure ReviewNoCommit
    Just commitSha -> do
      conflictResult <- checkMergeConflict (Text.unpack commitSha)
      case conflictResult of
        Just conflictFiles -> pure (ReviewMergeConflict commitSha conflictFiles)
        Nothing -> do
          (_, diffOut, _) <-
            Process.readProcessWithExitCode
              "git"
              ["show", Text.unpack commitSha]
              ""
          pure (ReviewReady commitSha (Text.pack diffOut))

getDiffForCommit :: Text -> IO (Maybe Text)
getDiffForCommit commitSha = do
  (code, diffOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["show", Text.unpack commitSha]
      ""
  case code of
    Exit.ExitSuccess -> pure (Just (Text.pack diffOut))
    Exit.ExitFailure _ -> pure Nothing

findCommitForTask :: Text -> IO (Maybe Text)
findCommitForTask tid = do
  let grepArg = "--grep=" <> Text.unpack tid
  (code, shaOut, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "--pretty=format:%H", "-n", "1", grepArg]
      ""
  if code /= Exit.ExitSuccess || null shaOut
    then pure Nothing
    else case List.lines shaOut of
      (x : _) -> pure (Just (Text.pack x))
      [] -> pure Nothing

getCommitsForTask :: Text -> IO [GitCommit]
getCommitsForTask tid = do
  let grepArg = "--grep=Task-Id: " <> Text.unpack tid
  (code, out, _) <-
    Process.readProcessWithExitCode
      "git"
      ["log", "--pretty=format:%H|%h|%s|%an|%ar", grepArg]
      ""
  if code /= Exit.ExitSuccess || null out
    then pure []
    else do
      let commitLines = filter (not <. null) (List.lines out)
      traverse parseCommitLine commitLines
  where
    parseCommitLine :: String -> IO GitCommit
    parseCommitLine line =
      case Text.splitOn "|" (Text.pack line) of
        [sha, shortSha, summary, author, relDate] -> do
          filesCount <- getFilesChangedCount (Text.unpack sha)
          pure
            GitCommit
              { commitHash = sha,
                commitShortHash = shortSha,
                commitSummary = summary,
                commitAuthor = author,
                commitRelativeDate = relDate,
                commitFilesChanged = filesCount
              }
        _ ->
          pure
            GitCommit
              { commitHash = Text.pack line,
                commitShortHash = Text.take 7 (Text.pack line),
                commitSummary = "(parse error)",
                commitAuthor = "",
                commitRelativeDate = "",
                commitFilesChanged = 0
              }

    getFilesChangedCount :: String -> IO Int
    getFilesChangedCount sha = do
      (code', out', _) <-
        Process.readProcessWithExitCode
          "git"
          ["show", "--stat", "--format=", sha]
          ""
      pure
        <| if code' /= Exit.ExitSuccess
          then 0
          else
            let statLines = filter (not <. null) (List.lines out')
             in max 0 (length statLines - 1)

checkMergeConflict :: String -> IO (Maybe [Text])
checkMergeConflict commitSha = do
  (_, origHead, _) <- Process.readProcessWithExitCode "git" ["rev-parse", "HEAD"] ""

  (cpCode, _, cpErr) <-
    Process.readProcessWithExitCode
      "git"
      ["cherry-pick", "--no-commit", commitSha]
      ""

  _ <- Process.readProcessWithExitCode "git" ["cherry-pick", "--abort"] ""
  _ <- Process.readProcessWithExitCode "git" ["reset", "--hard", List.head (List.lines origHead)] ""

  case cpCode of
    Exit.ExitSuccess -> pure Nothing
    Exit.ExitFailure _ -> do
      let errLines = Text.lines (Text.pack cpErr)
          conflictLines = filter (Text.isPrefixOf "CONFLICT") errLines
          files = mapMaybe extractConflictFile conflictLines
      pure (Just (if null files then ["(unknown files)"] else files))

extractConflictFile :: Text -> Maybe Text
extractConflictFile line =
  case Text.breakOn "Merge conflict in " line of
    (_, rest)
      | not (Text.null rest) -> Just (Text.strip (Text.drop 18 rest))
    _ -> case Text.breakOn "in " line of
      (_, rest)
        | not (Text.null rest) -> Just (Text.strip (Text.drop 3 rest))
      _ -> Nothing

app :: Application
app = serve api server

run :: Warp.Port -> IO ()
run port = do
  TaskCore.initTaskDb
  putText <| "Starting Jr web server on port " <> tshow port
  Warp.run port app