commit 10068667c7255facc5cdd10d71d437b5a0e4eea2
Author: Ben Sima <ben@bensima.com>
Date: Sat Nov 29 18:44:52 2025
Add breadcrumbs navigation for task hierarchy
The implementation is complete. Here's a summary of the changes made:
1. Added `Breadcrumb` data type and `Breadcrumbs` type alias
2. Added `pageBodyWithCrumbs` function that renders the page with
breadc 3. Added `renderBreadcrumbs` function to render the breadcrumb
navigatio 4. Added `getAncestors` helper to traverse task parent chain
5. Added `taskBreadcrumbs` helper to build breadcrumbs including parent
Updated all page ToHtml instances to use breadcrumbs: -
`ReadyQueuePage`: Jr > Ready Queue - `BlockedPage`: Jr > Blocked -
`InterventionPage`: Jr > Needs Intervention - `KBPage`: Jr > Knowledge
Base - `FactDetailPage`: Jr > Knowledge Base > Fact #N - `EpicsPage`:
Jr > Epics - `TaskListPage`: Jr > Tasks - `TaskDetailPage`: Jr >
Tasks > (parent chain) > task-id - `TaskReviewPage`: Jr > Tasks >
task-id > Review - `TaskDiffPage`: Jr > Tasks > task-id > Diff (short
hash) - `StatsPage`: Jr > Stats - `HomePage`: Uses regular `pageBody`
(no breadcrumbs)
Added `breadcrumbStyles` function with CSS for: -
`.breadcrumb-container`: Light gray background, subtle bottom border -
`.breadcrumb-list`: Flex layout with wrapping - `.breadcrumb-item`:
Flex items with gap - `.breadcrumb-sep`: Gray separator ">" -
`.breadcrumb-current`: Current page label (no link) - Link styling
for breadcrumb links
Added dark mode overrides for breadcrumbs in `darkModeStyles`.
Task-Id: t-172
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index a479bf96..2f8e693f 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -338,6 +338,54 @@ pageBody content =
navbar
content
+data Breadcrumb = Breadcrumb
+ { _crumbLabel :: Text,
+ _crumbHref :: Maybe Text
+ }
+
+type Breadcrumbs = [Breadcrumb]
+
+pageBodyWithCrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m () -> Lucid.HtmlT m ()
+pageBodyWithCrumbs crumbs content =
+ Lucid.body_ [Lucid.makeAttribute "hx-boost" "true"] <| do
+ navbar
+ unless (null crumbs) <| do
+ Lucid.div_ [Lucid.class_ "breadcrumb-container"] <| do
+ Lucid.div_ [Lucid.class_ "container"] <| renderBreadcrumbs crumbs
+ content
+
+renderBreadcrumbs :: (Monad m) => Breadcrumbs -> Lucid.HtmlT m ()
+renderBreadcrumbs [] = pure ()
+renderBreadcrumbs crumbs =
+ Lucid.nav_ [Lucid.class_ "breadcrumbs", Lucid.makeAttribute "aria-label" "Breadcrumb"] <| do
+ Lucid.ol_ [Lucid.class_ "breadcrumb-list"] <| do
+ traverse_ renderCrumb (zip [0 ..] crumbs)
+ where
+ renderCrumb :: (Monad m') => (Int, Breadcrumb) -> Lucid.HtmlT m' ()
+ renderCrumb (idx, Breadcrumb label mHref) = do
+ Lucid.li_ [Lucid.class_ "breadcrumb-item"] <| do
+ when (idx > 0) <| Lucid.span_ [Lucid.class_ "breadcrumb-sep"] ">"
+ case mHref of
+ Just href -> Lucid.a_ [Lucid.href_ href] (Lucid.toHtml label)
+ Nothing -> Lucid.span_ [Lucid.class_ "breadcrumb-current"] (Lucid.toHtml label)
+
+getAncestors :: [TaskCore.Task] -> TaskCore.Task -> [TaskCore.Task]
+getAncestors allTasks task =
+ case TaskCore.taskParent task of
+ Nothing -> [task]
+ Just pid -> case TaskCore.findTask pid allTasks of
+ Nothing -> [task]
+ Just parent -> getAncestors allTasks parent ++ [task]
+
+taskBreadcrumbs :: [TaskCore.Task] -> TaskCore.Task -> Breadcrumbs
+taskBreadcrumbs allTasks task =
+ let ancestors = getAncestors allTasks task
+ taskCrumbs = [Breadcrumb (TaskCore.taskId t) (Just ("/tasks/" <> TaskCore.taskId t)) | t <- List.init ancestors]
+ currentCrumb = Breadcrumb (TaskCore.taskId task) Nothing
+ in [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks")]
+ ++ taskCrumbs
+ ++ [currentCrumb]
+
navbar :: (Monad m) => Lucid.HtmlT m ()
navbar =
Lucid.nav_ [Lucid.class_ "navbar"] <| do
@@ -592,107 +640,111 @@ instance Lucid.ToHtml HomePage where
instance Lucid.ToHtml ReadyQueuePage where
toHtmlRaw = Lucid.toHtml
toHtml (ReadyQueuePage tasks _now) =
- Lucid.doctypehtml_ <| do
- pageHead "Ready Queue - Jr"
- pageBody <| do
- 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
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Ready Queue" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Ready Queue - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.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"
- pageBody <| do
- 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
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Blocked" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Blocked Tasks - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.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"
- pageBody <| do
- 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
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Needs Intervention" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Needs Intervention - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ 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"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Knowledge Base"
- Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution."
-
- Lucid.details_ [Lucid.class_ "create-fact-section"] <| do
- Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ "/kb/create",
- Lucid.class_ "fact-create-form"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "project"] "Project:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "project",
- Lucid.id_ "project",
- Lucid.class_ "form-input",
- Lucid.required_ "required",
- Lucid.placeholder_ "e.g., Omni/Jr"
- ]
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
- Lucid.textarea_
- [ Lucid.name_ "content",
- Lucid.id_ "content",
- Lucid.class_ "form-textarea",
- Lucid.rows_ "4",
- Lucid.required_ "required",
- Lucid.placeholder_ "Describe the fact or knowledge..."
- ]
- ""
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "files",
- Lucid.id_ "files",
- Lucid.class_ "form-input",
- Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs"
- ]
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
- Lucid.input_
- [ Lucid.type_ "number",
- Lucid.name_ "confidence",
- Lucid.id_ "confidence",
- Lucid.class_ "form-input",
- Lucid.step_ "0.1",
- Lucid.min_ "0",
- Lucid.max_ "1",
- Lucid.value_ "0.8"
- ]
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact"
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Knowledge Base - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Knowledge Base"
+ Lucid.p_ [Lucid.class_ "info-msg"] "Facts learned during task execution."
+
+ Lucid.details_ [Lucid.class_ "create-fact-section"] <| do
+ Lucid.summary_ [Lucid.class_ "btn btn-primary create-fact-toggle"] "Create New Fact"
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ "/kb/create",
+ Lucid.class_ "fact-create-form"
+ ]
+ <| do
+ Lucid.div_ [Lucid.class_ "form-group"] <| do
+ Lucid.label_ [Lucid.for_ "project"] "Project:"
+ Lucid.input_
+ [ Lucid.type_ "text",
+ Lucid.name_ "project",
+ Lucid.id_ "project",
+ Lucid.class_ "form-input",
+ Lucid.required_ "required",
+ Lucid.placeholder_ "e.g., Omni/Jr"
+ ]
+ Lucid.div_ [Lucid.class_ "form-group"] <| do
+ Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
+ Lucid.textarea_
+ [ Lucid.name_ "content",
+ Lucid.id_ "content",
+ Lucid.class_ "form-textarea",
+ Lucid.rows_ "4",
+ Lucid.required_ "required",
+ Lucid.placeholder_ "Describe the fact or knowledge..."
+ ]
+ ""
+ Lucid.div_ [Lucid.class_ "form-group"] <| do
+ Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
+ Lucid.input_
+ [ Lucid.type_ "text",
+ Lucid.name_ "files",
+ Lucid.id_ "files",
+ Lucid.class_ "form-input",
+ Lucid.placeholder_ "path/to/file1.hs, path/to/file2.hs"
+ ]
+ Lucid.div_ [Lucid.class_ "form-group"] <| do
+ Lucid.label_ [Lucid.for_ "confidence"] "Confidence (0.0 - 1.0):"
+ Lucid.input_
+ [ Lucid.type_ "number",
+ Lucid.name_ "confidence",
+ Lucid.id_ "confidence",
+ Lucid.class_ "form-input",
+ Lucid.step_ "0.1",
+ Lucid.min_ "0",
+ Lucid.max_ "1",
+ Lucid.value_ "0.8"
+ ]
+ Lucid.div_ [Lucid.class_ "form-actions"] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Create Fact"
- if null facts
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No facts recorded yet."
- else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderFactCard facts
+ 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 =
@@ -726,93 +778,96 @@ instance Lucid.ToHtml KBPage where
instance Lucid.ToHtml FactDetailPage where
toHtmlRaw = Lucid.toHtml
toHtml (FactDetailNotFound fid) =
- Lucid.doctypehtml_ <| do
- pageHead "Fact Not Found - Jr"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Fact Not Found"
- Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found."))
- Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base"
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> tshow fid) Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Fact Not Found - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Fact Not Found"
+ Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found."))
+ Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base"
toHtml (FactDetailFound fact now) =
- Lucid.doctypehtml_ <| do
- pageHead "Fact Detail - Jr"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "task-detail-header"] <| do
- Lucid.h1_ <| do
- Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact)))
- Lucid.div_ [Lucid.class_ "task-meta-row"] <| do
- Lucid.span_ [Lucid.class_ "meta-label"] "Project:"
- Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact))
- Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:"
- confidenceBadgeDetail (TaskCore.factConfidence fact)
- Lucid.span_ [Lucid.class_ "meta-label"] "Created:"
- Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact))
-
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h2_ "Content"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/kb/" <> maybe "-" tshow (TaskCore.factId fact) <> "/edit"),
- Lucid.class_ "fact-edit-form"
- ]
- <| do
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "content"] "Fact Content:"
- Lucid.textarea_
- [ Lucid.name_ "content",
- Lucid.id_ "content",
- Lucid.class_ "form-textarea",
- Lucid.rows_ "6"
- ]
- (Lucid.toHtml (TaskCore.factContent fact))
-
- Lucid.div_ [Lucid.class_ "form-group"] <| do
- Lucid.label_ [Lucid.for_ "files"] "Related Files (comma-separated):"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "files",
- Lucid.id_ "files",
- Lucid.class_ "form-input",
- Lucid.value_ (Text.intercalate ", " (TaskCore.factRelatedFiles fact))
- ]
+ let fid' = maybe "-" tshow (TaskCore.factId fact)
+ crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Knowledge Base" (Just "/kb"), Breadcrumb ("Fact #" <> fid') Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Fact Detail - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.div_ [Lucid.class_ "task-detail-header"] <| do
+ Lucid.h1_ <| do
+ Lucid.span_ [Lucid.class_ "detail-id"] (Lucid.toHtml ("Fact #" <> maybe "-" tshow (TaskCore.factId fact)))
+ Lucid.div_ [Lucid.class_ "task-meta-row"] <| do
+ Lucid.span_ [Lucid.class_ "meta-label"] "Project:"
+ Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (TaskCore.factProject fact))
+ Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:"
+ confidenceBadgeDetail (TaskCore.factConfidence fact)
+ Lucid.span_ [Lucid.class_ "meta-label"] "Created:"
+ Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact))
- Lucid.div_ [Lucid.class_ "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_ "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-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "btn btn-primary"] "Save Changes"
+ 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))
+ ]
- 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_ "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"
+ 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 =
@@ -826,15 +881,16 @@ instance Lucid.ToHtml FactDetailPage where
instance Lucid.ToHtml EpicsPage where
toHtmlRaw = Lucid.toHtml
toHtml (EpicsPage epics allTasks) =
- Lucid.doctypehtml_ <| do
- pageHead "Epics - Jr"
- pageBody <| do
- 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
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Epics" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Epics - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.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 =
@@ -906,68 +962,69 @@ getDescendants allTasks parentId =
instance Lucid.ToHtml TaskListPage where
toHtmlRaw = Lucid.toHtml
toHtml (TaskListPage tasks filters _now) =
- Lucid.doctypehtml_ <| do
- pageHead "Tasks - Jr"
- pageBody <| do
- 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))
- ]
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Tasks - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.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.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
+ 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]
@@ -985,148 +1042,150 @@ instance Lucid.ToHtml TaskListPage where
instance Lucid.ToHtml TaskDetailPage where
toHtmlRaw = Lucid.toHtml
toHtml (TaskDetailNotFound tid) =
- Lucid.doctypehtml_ <| do
- pageHead "Task Not Found - Jr"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Task Not Found"
- Lucid.p_ <| do
- "The task "
- Lucid.code_ (Lucid.toHtml tid)
- " could not be found."
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Task Not Found - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Task Not Found"
+ Lucid.p_ <| do
+ "The task "
+ Lucid.code_ (Lucid.toHtml tid)
+ " could not be found."
toHtml (TaskDetailFound task allTasks activities maybeRetry commits maybeAggMetrics now) =
- Lucid.doctypehtml_ <| do
- pageHead (TaskCore.taskId task <> " - Jr")
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
-
- renderRetryContextBanner (TaskCore.taskId task) maybeRetry
-
- Lucid.div_ [Lucid.class_ "task-detail"] <| do
- Lucid.div_ [Lucid.class_ "task-meta"] <| do
- Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
- Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
- metaSep
- statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-priority"] <| 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 -> do
+ let crumbs = taskBreadcrumbs allTasks task
+ in Lucid.doctypehtml_ <| do
+ pageHead (TaskCore.taskId task <> " - Jr")
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task)
+
+ renderRetryContextBanner (TaskCore.taskId task) maybeRetry
+
+ Lucid.div_ [Lucid.class_ "task-detail"] <| do
+ Lucid.div_ [Lucid.class_ "task-meta"] <| do
+ Lucid.div_ [Lucid.class_ "task-meta-primary"] <| do
+ Lucid.code_ [Lucid.class_ "task-meta-id"] (Lucid.toHtml (TaskCore.taskId task))
metaSep
- Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
-
- Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
- case TaskCore.taskParent task of
- Nothing -> pure ()
- Just pid -> do
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
- Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
+ Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
metaSep
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
- renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
- metaSep
- Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
- renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
-
- let deps = TaskCore.taskDependencies task
- unless (null deps) <| do
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Dependencies"
- Lucid.ul_ [Lucid.class_ "dep-list"] <| do
- traverse_ renderDependency deps
-
- case TaskCore.taskType task of
- TaskCore.Epic -> do
- for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Design"
- if Text.null (TaskCore.taskDescription task)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
- else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown (TaskCore.taskDescription task))
- 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 (TaskCore.taskDescription task))
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Design"
- _ ->
- Lucid.div_ [Lucid.class_ "detail-section"] <| do
- Lucid.h3_ "Description"
- if Text.null (TaskCore.taskDescription task)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No description yet."
- else Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml (TaskCore.taskDescription task))
- Lucid.details_ [Lucid.class_ "edit-description"] <| do
- Lucid.summary_ "Edit Description"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description"),
- Lucid.makeAttribute "hx-post" ("/tasks/" <> TaskCore.taskId task <> "/description"),
- Lucid.makeAttribute "hx-swap" "none"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "description",
- Lucid.class_ "description-textarea",
- Lucid.rows_ "10",
- Lucid.placeholder_ "Enter description..."
+ statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
+ metaSep
+ Lucid.span_ [Lucid.class_ "task-meta-priority"] <| 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 -> do
+ metaSep
+ Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
+
+ Lucid.div_ [Lucid.class_ "task-meta-secondary"] <| do
+ case TaskCore.taskParent task of
+ Nothing -> pure ()
+ Just pid -> do
+ Lucid.span_ [Lucid.class_ "task-meta-label"] "Parent:"
+ Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "task-link"] (Lucid.toHtml pid)
+ metaSep
+ Lucid.span_ [Lucid.class_ "task-meta-label"] "Created"
+ renderRelativeTimestamp now (TaskCore.taskCreatedAt task)
+ metaSep
+ Lucid.span_ [Lucid.class_ "task-meta-label"] "Updated"
+ renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)
+
+ let deps = TaskCore.taskDependencies task
+ unless (null deps) <| do
+ Lucid.div_ [Lucid.class_ "detail-section"] <| do
+ Lucid.h3_ "Dependencies"
+ Lucid.ul_ [Lucid.class_ "dep-list"] <| do
+ traverse_ renderDependency deps
+
+ case TaskCore.taskType task of
+ TaskCore.Epic -> do
+ for_ maybeAggMetrics (renderAggregatedMetrics allTasks task)
+ Lucid.div_ [Lucid.class_ "detail-section"] <| do
+ Lucid.h3_ "Design"
+ if Text.null (TaskCore.taskDescription task)
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No design document yet."
+ else Lucid.div_ [Lucid.class_ "markdown-content"] (renderMarkdown (TaskCore.taskDescription task))
+ 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 (TaskCore.taskDescription task))
+ Lucid.div_ [Lucid.class_ "form-actions"] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Design"
+ _ ->
+ Lucid.div_ [Lucid.class_ "detail-section"] <| do
+ Lucid.h3_ "Description"
+ if Text.null (TaskCore.taskDescription task)
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No description yet."
+ else Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml (TaskCore.taskDescription task))
+ Lucid.details_ [Lucid.class_ "edit-description"] <| do
+ Lucid.summary_ "Edit Description"
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/description"),
+ Lucid.makeAttribute "hx-post" ("/tasks/" <> TaskCore.taskId task <> "/description"),
+ Lucid.makeAttribute "hx-swap" "none"
]
- (Lucid.toHtml (TaskCore.taskDescription task))
- Lucid.div_ [Lucid.class_ "form-actions"] <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Description"
-
- 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"
+ <| do
+ Lucid.textarea_
+ [ Lucid.name_ "description",
+ Lucid.class_ "description-textarea",
+ Lucid.rows_ "10",
+ Lucid.placeholder_ "Enter description..."
+ ]
+ (Lucid.toHtml (TaskCore.taskDescription task))
+ Lucid.div_ [Lucid.class_ "form-actions"] <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Save Description"
+
+ 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
renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m ()
renderDependency dep =
@@ -1409,161 +1468,169 @@ renderRetryContextBanner tid (Just ctx) =
instance Lucid.ToHtml TaskReviewPage where
toHtmlRaw = Lucid.toHtml
toHtml (ReviewPageNotFound tid) =
- Lucid.doctypehtml_ <| do
- pageHead "Task Not Found - Jr Review"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Task Not Found"
- Lucid.p_ <| do
- "The task "
- Lucid.code_ (Lucid.toHtml tid)
- " could not be found."
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Task Not Found - Jr Review"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Task Not Found"
+ Lucid.p_ <| do
+ "The task "
+ Lucid.code_ (Lucid.toHtml tid)
+ " could not be found."
toHtml (ReviewPageFound task reviewInfo) =
- Lucid.doctypehtml_ <| do
- pageHead ("Review: " <> TaskCore.taskId task <> " - Jr")
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Review Task"
-
- Lucid.div_ [Lucid.class_ "task-summary"] <| do
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
- Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
- Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
-
- case reviewInfo of
- ReviewNoCommit ->
- Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
- Lucid.h3_ "No Commit Found"
- Lucid.p_ "No commit with this task ID was found in the git history."
- Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
- ReviewMergeConflict commitSha conflictFiles ->
- Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
- Lucid.h3_ "Merge Conflict Detected"
- Lucid.p_ <| do
- "Commit "
- Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
- " cannot be cleanly merged."
- Lucid.p_ "Conflicting files:"
- Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
- ReviewReady commitSha diffText -> do
- Lucid.div_ [Lucid.class_ "diff-section"] <| do
- Lucid.h3_ <| do
- "Commit: "
- Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
- Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)
-
- Lucid.div_ [Lucid.class_ "review-actions"] <| do
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
- Lucid.class_ "inline-form"
- ]
- <| do
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"
+ let tid = TaskCore.taskId task
+ crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb "Review" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead ("Review: " <> TaskCore.taskId task <> " - Jr")
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Review Task"
+
+ Lucid.div_ [Lucid.class_ "task-summary"] <| do
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "ID:"
+ Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Title:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskTitle task))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Status:"
+ Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task)
+
+ case reviewInfo of
+ ReviewNoCommit ->
+ Lucid.div_ [Lucid.class_ "no-commit-msg"] <| do
+ Lucid.h3_ "No Commit Found"
+ Lucid.p_ "No commit with this task ID was found in the git history."
+ Lucid.p_ "The worker may not have completed yet, or the commit message doesn't include the task ID."
+ ReviewMergeConflict commitSha conflictFiles ->
+ Lucid.div_ [Lucid.class_ "conflict-warning"] <| do
+ Lucid.h3_ "Merge Conflict Detected"
+ Lucid.p_ <| do
+ "Commit "
+ Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
+ " cannot be cleanly merged."
+ Lucid.p_ "Conflicting files:"
+ Lucid.ul_ <| traverse_ (Lucid.li_ <. Lucid.toHtml) conflictFiles
+ ReviewReady commitSha diffText -> do
+ Lucid.div_ [Lucid.class_ "diff-section"] <| do
+ Lucid.h3_ <| do
+ "Commit: "
+ Lucid.code_ (Lucid.toHtml (Text.take 8 commitSha))
+ Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffText)
+
+ Lucid.div_ [Lucid.class_ "review-actions"] <| do
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/accept"),
+ Lucid.class_ "inline-form"
+ ]
+ <| do
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "accept-btn"] "Accept"
- Lucid.form_
- [ Lucid.method_ "POST",
- Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
- Lucid.class_ "reject-form"
- ]
- <| do
- Lucid.textarea_
- [ Lucid.name_ "notes",
- Lucid.class_ "reject-notes",
- Lucid.placeholder_ "Rejection notes (optional)"
+ Lucid.form_
+ [ Lucid.method_ "POST",
+ Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/reject"),
+ Lucid.class_ "reject-form"
]
- ""
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "reject-btn"] "Reject"
+ <| 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"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ "Commit Not Found"
- Lucid.p_ <| do
- "Could not find commit "
- Lucid.code_ (Lucid.toHtml commitHash')
- Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
+ let shortHash = Text.take 8 commitHash'
+ crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Commit Not Found - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ "Commit Not Found"
+ Lucid.p_ <| do
+ "Could not find commit "
+ Lucid.code_ (Lucid.toHtml commitHash')
+ Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
toHtml (DiffPageFound tid commitHash' diffOutput) =
- Lucid.doctypehtml_ <| do
- pageHead ("Diff " <> Text.take 8 commitHash' <> " - Jr")
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.div_ [Lucid.class_ "diff-header"] <| do
- Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
- Lucid.h1_ <| do
- "Commit "
- Lucid.code_ (Lucid.toHtml (Text.take 8 commitHash'))
- Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput)
+ let shortHash = Text.take 8 commitHash'
+ crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Tasks" (Just "/tasks"), Breadcrumb tid (Just ("/tasks/" <> tid)), Breadcrumb ("Diff " <> shortHash) Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead ("Diff " <> shortHash <> " - Jr")
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.div_ [Lucid.class_ "diff-header"] <| do
+ Lucid.a_ [Lucid.href_ ("/tasks/" <> tid), Lucid.class_ "back-link"] "← Back to task"
+ Lucid.h1_ <| do
+ "Commit "
+ Lucid.code_ (Lucid.toHtml shortHash)
+ Lucid.pre_ [Lucid.class_ "diff-block"] (Lucid.toHtml diffOutput)
instance Lucid.ToHtml StatsPage where
toHtmlRaw = Lucid.toHtml
toHtml (StatsPage stats maybeEpic) =
- Lucid.doctypehtml_ <| do
- pageHead "Task Statistics - Jr"
- pageBody <| do
- Lucid.div_ [Lucid.class_ "container"] <| do
- Lucid.h1_ <| case maybeEpic of
- Nothing -> "Task Statistics"
- Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId)
-
- Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do
- Lucid.div_ [Lucid.class_ "filter-row"] <| do
- Lucid.div_ [Lucid.class_ "filter-group"] <| do
- Lucid.label_ [Lucid.for_ "epic"] "Epic:"
- Lucid.input_
- [ Lucid.type_ "text",
- Lucid.name_ "epic",
- Lucid.id_ "epic",
- Lucid.class_ "filter-input",
- Lucid.placeholder_ "Epic ID (optional)",
- Lucid.value_ (fromMaybe "" maybeEpic)
- ]
- Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
- Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear"
-
- Lucid.h2_ "By Status"
- multiColorProgressBar stats
- Lucid.div_ [Lucid.class_ "stats-grid"] <| do
- statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats)
- statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats)
- statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats)
- statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats)
- statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats)
-
- Lucid.h2_ "By Priority"
- Lucid.div_ [Lucid.class_ "stats-section"] <| do
- traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats)
-
- Lucid.h2_ "By Namespace"
- Lucid.div_ [Lucid.class_ "stats-section"] <| do
- if null (TaskCore.tasksByNamespace stats)
- then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found."
- else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats)
-
- Lucid.h2_ "Summary"
- Lucid.div_ [Lucid.class_ "summary-section"] <| do
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Epics:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Ready:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats)))
- Lucid.div_ [Lucid.class_ "detail-row"] <| do
- Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:"
- Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats)))
+ let crumbs = [Breadcrumb "Jr" (Just "/"), Breadcrumb "Stats" Nothing]
+ in Lucid.doctypehtml_ <| do
+ pageHead "Task Statistics - Jr"
+ pageBodyWithCrumbs crumbs <| do
+ Lucid.div_ [Lucid.class_ "container"] <| do
+ Lucid.h1_ <| case maybeEpic of
+ Nothing -> "Task Statistics"
+ Just epicId -> Lucid.toHtml ("Statistics for Epic: " <> epicId)
+
+ Lucid.form_ [Lucid.method_ "GET", Lucid.action_ "/stats", Lucid.class_ "filter-form"] <| do
+ Lucid.div_ [Lucid.class_ "filter-row"] <| do
+ Lucid.div_ [Lucid.class_ "filter-group"] <| do
+ Lucid.label_ [Lucid.for_ "epic"] "Epic:"
+ Lucid.input_
+ [ Lucid.type_ "text",
+ Lucid.name_ "epic",
+ Lucid.id_ "epic",
+ Lucid.class_ "filter-input",
+ Lucid.placeholder_ "Epic ID (optional)",
+ Lucid.value_ (fromMaybe "" maybeEpic)
+ ]
+ Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "filter-btn"] "Filter"
+ Lucid.a_ [Lucid.href_ "/stats", Lucid.class_ "clear-btn"] "Clear"
+
+ Lucid.h2_ "By Status"
+ multiColorProgressBar stats
+ Lucid.div_ [Lucid.class_ "stats-grid"] <| do
+ statCard "Open" (TaskCore.openTasks stats) (TaskCore.totalTasks stats)
+ statCard "In Progress" (TaskCore.inProgressTasks stats) (TaskCore.totalTasks stats)
+ statCard "Review" (TaskCore.reviewTasks stats) (TaskCore.totalTasks stats)
+ statCard "Approved" (TaskCore.approvedTasks stats) (TaskCore.totalTasks stats)
+ statCard "Done" (TaskCore.doneTasks stats) (TaskCore.totalTasks stats)
+
+ Lucid.h2_ "By Priority"
+ Lucid.div_ [Lucid.class_ "stats-section"] <| do
+ traverse_ (uncurry renderPriorityRow) (TaskCore.tasksByPriority stats)
+
+ Lucid.h2_ "By Namespace"
+ Lucid.div_ [Lucid.class_ "stats-section"] <| do
+ if null (TaskCore.tasksByNamespace stats)
+ then Lucid.p_ [Lucid.class_ "empty-msg"] "No namespaces found."
+ else traverse_ (uncurry (renderNamespaceRow (TaskCore.totalTasks stats))) (TaskCore.tasksByNamespace stats)
+
+ Lucid.h2_ "Summary"
+ Lucid.div_ [Lucid.class_ "summary-section"] <| do
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Total Tasks:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalTasks stats)))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Epics:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.totalEpics stats)))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Ready:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.readyTasks stats)))
+ Lucid.div_ [Lucid.class_ "detail-row"] <| do
+ Lucid.span_ [Lucid.class_ "detail-label"] "Blocked:"
+ Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.blockedTasks stats)))
where
statCard :: (Monad m) => Text -> Int -> Int -> Lucid.HtmlT m ()
statCard label count total =
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index 84e01ede..49f7976b 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -24,6 +24,7 @@ stylesheet = do
baseStyles
layoutStyles
navigationStyles
+ breadcrumbStyles
cardStyles
listGroupStyles
statusBadges
@@ -264,6 +265,36 @@ navigationStyles = do
Stylesheet.key "gap" ("6px" :: Text)
marginBottom (px 8)
+breadcrumbStyles :: Css
+breadcrumbStyles = do
+ ".breadcrumb-container" ? do
+ backgroundColor "#f9fafb"
+ borderBottom (px 1) solid "#e5e7eb"
+ padding (px 6) (px 0) (px 6) (px 0)
+ ".breadcrumb-list" ? do
+ display flex
+ alignItems center
+ flexWrap Flexbox.wrap
+ Stylesheet.key "gap" ("4px" :: Text)
+ margin (px 0) (px 0) (px 0) (px 0)
+ padding (px 0) (px 0) (px 0) (px 0)
+ listStyleType none
+ fontSize (px 12)
+ ".breadcrumb-item" ? do
+ display flex
+ alignItems center
+ Stylesheet.key "gap" ("4px" :: Text)
+ ".breadcrumb-sep" ? do
+ color "#9ca3af"
+ Stylesheet.key "user-select" ("none" :: Text)
+ ".breadcrumb-current" ? do
+ color "#6b7280"
+ fontWeight (weight 500)
+ (".breadcrumb-list" ** a) ? do
+ color "#0066cc"
+ textDecoration none
+ (".breadcrumb-list" ** a) # hover ? textDecoration underline
+
cardStyles :: Css
cardStyles = do
".card"
@@ -1273,6 +1304,11 @@ darkModeStyles =
".nav-brand" ? color "#f3f4f6"
"h2" <> "h3" ? color "#d1d5db"
a ? color "#60a5fa"
+ ".breadcrumb-container" ? do
+ backgroundColor "#1f2937"
+ borderBottomColor "#374151"
+ ".breadcrumb-sep" ? color "#6b7280"
+ ".breadcrumb-current" ? color "#9ca3af"
".detail-label"
<> ".priority"