Make complexity badge editable on task detail page

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

1: {-# LANGUAGE OverloadedStrings #-}
2: {-# LANGUAGE NoImplicitPrelude #-}
3: 
4: -- | Jr Web UI - Main module that re-exports the API and provides the run function.
5: --
6: -- The web interface is split into submodules:
7: -- - Types: Data types for pages, partials, and forms
8: -- - Components: Reusable UI components and helpers
9: -- - Pages: Full page ToHtml instances
10: -- - Partials: HTMX partial ToHtml instances
11: -- - Handlers: Servant handler implementations
12: -- - Style: CSS styling
13: --
14: -- : dep warp
15: -- : dep servant-server
16: -- : dep lucid
17: -- : dep servant-lucid
18: module Omni.Jr.Web
19:   ( run,
20:     defaultPort,
21:     -- Re-exports for external use
22:     API,
23:     server,
24:   )
25: where
26: 
27: import Alpha
28: import qualified Network.Wai.Handler.Warp as Warp
29: import Omni.Jr.Web.Handlers (API, api, server)
30: import Omni.Jr.Web.Pages ()
31: import Omni.Jr.Web.Partials ()
32: import Servant (serve)
33: 
34: defaultPort :: Warp.Port
35: defaultPort = 8080
36: 
37: run :: Warp.Port -> IO ()
38: run port = do
39:   putText <| "Starting Jr web server on port " <> tshow port
40:   Warp.run port (serve api server)

620: 
621: -- * Status badge with form
622: 
623: statusBadgeWithForm :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
624: statusBadgeWithForm status tid =
625:   Lucid.div_
626:     [ Lucid.id_ "status-badge-container",
627:       Lucid.class_ "status-badge-dropdown"
628:     ]
629:     <| do
630:       clickableBadge status tid
631:       statusDropdownOptions status tid
632: 
633: clickableBadge :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
634: clickableBadge status _tid =
635:   let (cls, label) = case status of
636:         TaskCore.Draft -> ("badge badge-draft status-badge-clickable", "Draft" :: Text)
637:         TaskCore.Open -> ("badge badge-open status-badge-clickable", "Open")
638:         TaskCore.InProgress -> ("badge badge-inprogress status-badge-clickable", "In Progress")
639:         TaskCore.Review -> ("badge badge-review status-badge-clickable", "Review")
640:         TaskCore.Approved -> ("badge badge-approved status-badge-clickable", "Approved")
641:         TaskCore.Done -> ("badge badge-done status-badge-clickable", "Done")
642:         TaskCore.NeedsHelp -> ("badge badge-needshelp status-badge-clickable", "Needs Help")
643:    in Lucid.span_
644:         [ Lucid.class_ cls,
645:           Lucid.tabindex_ "0",
646:           Lucid.role_ "button",
647:           Lucid.makeAttribute "aria-haspopup" "true",
648:           Lucid.makeAttribute "aria-expanded" "false",
649:           Lucid.makeAttribute "onclick" "toggleStatusDropdown(this)",
650:           Lucid.makeAttribute "onkeydown" "handleStatusKeydown(event, this)"
651:         ]
652:         <| do
653:           Lucid.toHtml label
654:           Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
655: 
656: statusDropdownOptions :: (Monad m) => TaskCore.Status -> Text -> Lucid.HtmlT m ()
657: statusDropdownOptions currentStatus tid =
658:   Lucid.div_
659:     [ Lucid.class_ "status-dropdown-menu",
660:       Lucid.role_ "menu",
661:       Lucid.makeAttribute "aria-label" "Change task status"
662:     ]
663:     <| do
664:       statusOption TaskCore.Draft currentStatus tid
665:       statusOption TaskCore.Open currentStatus tid
666:       statusOption TaskCore.InProgress currentStatus tid
667:       statusOption TaskCore.Review currentStatus tid
668:       statusOption TaskCore.Approved currentStatus tid
669:       statusOption TaskCore.Done currentStatus tid
670:       statusOption TaskCore.NeedsHelp currentStatus tid
671: 
672: statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Text -> Lucid.HtmlT m ()
673: statusOption opt currentStatus tid =
674:   let (cls, label) = case opt of
675:         TaskCore.Draft -> ("badge badge-draft", "Draft" :: Text)
676:         TaskCore.Open -> ("badge badge-open", "Open")
677:         TaskCore.InProgress -> ("badge badge-inprogress", "In Progress")
678:         TaskCore.Review -> ("badge badge-review", "Review")
679:         TaskCore.Approved -> ("badge badge-approved", "Approved")
680:         TaskCore.Done -> ("badge badge-done", "Done")
681:         TaskCore.NeedsHelp -> ("badge badge-needshelp", "Needs Help")
682:       isSelected = opt == currentStatus
683:       optClass = cls <> " status-dropdown-option" <> if isSelected then " selected" else ""
684:    in Lucid.form_
685:         [ Lucid.class_ "status-option-form",
686:           Lucid.role_ "none",
687:           Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/status"),
688:           Lucid.makeAttribute "hx-target" "#status-badge-container",
689:           Lucid.makeAttribute "hx-swap" "outerHTML"
690:         ]
691:         <| do
692:           Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "status", Lucid.value_ (tshow opt)]
693:           Lucid.button_
694:             [ Lucid.type_ "submit",
695:               Lucid.class_ optClass,
696:               Lucid.role_ "menuitem",
697:               Lucid.tabindex_ "-1",
698:               Lucid.makeAttribute "onkeydown" "handleMenuItemKeydown(event)"
699:             ]
700:             (Lucid.toHtml label)
701: 
702: -- * Priority badge with form
703: 
704: priorityBadgeWithForm :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
705: priorityBadgeWithForm priority tid =
706:   Lucid.div_
707:     [ Lucid.id_ "priority-badge-container",
708:       Lucid.class_ "priority-badge-dropdown"
709:     ]
710:     <| do
711:       clickablePriorityBadge priority tid
712:       priorityDropdownOptions priority tid
713: 
714: clickablePriorityBadge :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
715: clickablePriorityBadge priority _tid =
716:   let (cls, label) = case priority of
717:         TaskCore.P0 -> ("badge badge-p0 priority-badge-clickable", "P0 Critical" :: Text)
718:         TaskCore.P1 -> ("badge badge-p1 priority-badge-clickable", "P1 High")
719:         TaskCore.P2 -> ("badge badge-p2 priority-badge-clickable", "P2 Normal")
720:         TaskCore.P3 -> ("badge badge-p3 priority-badge-clickable", "P3 Low")
721:         TaskCore.P4 -> ("badge badge-p4 priority-badge-clickable", "P4 Defer")
722:    in Lucid.span_
723:         [ Lucid.class_ cls,
724:           Lucid.tabindex_ "0",
725:           Lucid.role_ "button",
726:           Lucid.makeAttribute "aria-haspopup" "true",
727:           Lucid.makeAttribute "aria-expanded" "false",
728:           Lucid.makeAttribute "onclick" "togglePriorityDropdown(this)",
729:           Lucid.makeAttribute "onkeydown" "handlePriorityKeydown(event, this)"
730:         ]
731:         <| do
732:           Lucid.toHtml label
733:           Lucid.span_ [Lucid.class_ "dropdown-arrow", Lucid.makeAttribute "aria-hidden" "true"] " ▾"
734: 
735: priorityDropdownOptions :: (Monad m) => TaskCore.Priority -> Text -> Lucid.HtmlT m ()
736: priorityDropdownOptions currentPriority tid =
737:   Lucid.div_
738:     [ Lucid.class_ "priority-dropdown-menu",
739:       Lucid.role_ "menu",
740:       Lucid.makeAttribute "aria-label" "Change task priority"
741:     ]
742:     <| do
743:       priorityOption TaskCore.P0 currentPriority tid
744:       priorityOption TaskCore.P1 currentPriority tid
745:       priorityOption TaskCore.P2 currentPriority tid
746:       priorityOption TaskCore.P3 currentPriority tid
747:       priorityOption TaskCore.P4 currentPriority tid
748: 
749: priorityOption :: (Monad m) => TaskCore.Priority -> TaskCore.Priority -> Text -> Lucid.HtmlT m ()
750: priorityOption opt currentPriority tid =

750: priorityOption opt currentPriority tid =
751:   let (cls, label) = case opt of
752:         TaskCore.P0 -> ("badge badge-p0", "P0 Critical" :: Text)
753:         TaskCore.P1 -> ("badge badge-p1", "P1 High")
754:         TaskCore.P2 -> ("badge badge-p2", "P2 Normal")
755:         TaskCore.P3 -> ("badge badge-p3", "P3 Low")
756:         TaskCore.P4 -> ("badge badge-p4", "P4 Defer")
757:       isSelected = opt == currentPriority
758:       optClass = cls <> " priority-dropdown-option" <> if isSelected then " selected" else ""
759:    in Lucid.form_
760:         [ Lucid.class_ "priority-option-form",
761:           Lucid.role_ "none",
762:           Lucid.makeAttribute "hx-post" ("/tasks/" <> tid <> "/priority"),
763:           Lucid.makeAttribute "hx-target" "#priority-badge-container",
764:           Lucid.makeAttribute "hx-swap" "outerHTML"
765:         ]
766:         <| do
767:           Lucid.input_ [Lucid.type_ "hidden", Lucid.name_ "priority", Lucid.value_ (tshow opt)]
768:           Lucid.button_
769:             [ Lucid.type_ "submit",
770:               Lucid.class_ optClass,

39:    taskComplexity :: Maybe Int, -- Complexity 1-5 for model selection
306:      <*> SQL.field -- complexity
322:      SQL.toField (taskComplexity t),
460:      \ complexity INTEGER, \
538:    ("complexity", "INTEGER"),
638:    SQL.query_ conn "SELECT id, title, type, parent, namespace, status, priority, complexity, dependencies, description, comments, created_at, updated_at FROM tasks"
647:      \ (id, title, type, parent, namespace, status, priority, complexity, dependencies, description, comments, created_at, updated_at) \
653:createTask title taskType parent namespace priority complexity deps description =
673:              taskComplexity = complexity,
1027:  case taskComplexity t of
1029:    Just c -> putText ("Complexity: " <> T.pack (show c) <> "/5")

565:                     Lucid.span_ [Lucid.class_ "task-meta-type"] (Lucid.toHtml (tshow (TaskCore.taskType task)))
566:                     metaSep
567:                     statusBadgeWithForm (TaskCore.taskStatus task) (TaskCore.taskId task)
568:                     metaSep
569:                     priorityBadgeWithForm (TaskCore.taskPriority task) (TaskCore.taskId task)
570:                     case TaskCore.taskComplexity task of
571:                       Nothing -> pure ()
572:                       Just c -> do
573:                         metaSep
574:                         complexityBadge c
575:                     case TaskCore.taskNamespace task of
576:                       Nothing -> pure ()
577:                       Just ns -> do
578:                         metaSep
579:                         Lucid.span_ [Lucid.class_ "task-meta-ns"] (Lucid.toHtml ns)
580: 

509: complexityBadge :: (Monad m) => Int -> Lucid.HtmlT m ()
510: complexityBadge complexity =
511:   let cls = "badge badge-complexity badge-complexity-" <> tshow complexity
512:       label = "ℂ " <> tshow complexity
513:    in Lucid.span_ [Lucid.class_ cls, Lucid.title_ "Task Complexity (1-5)"] (Lucid.toHtml label)
514: 
515: -- * Sort dropdown
516: 
517: sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
518: sortDropdown basePath currentSort =
519:   Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
520:     Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
521:     Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
522:       Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
523:         <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
524:       Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
525:         sortOption basePath SortNewest currentSort
526:         sortOption basePath SortOldest currentSort
527:         sortOption basePath SortUpdated currentSort
528:         sortOption basePath SortPriorityHigh currentSort
529:         sortOption basePath SortPriorityLow currentSort
530: 

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE TypeOperators #-}
4: {-# LANGUAGE NoImplicitPrelude #-}
5: 
6: -- : dep warp
7: -- : dep servant-server
8: -- : dep lucid
9: -- : dep servant-lucid
10: -- : dep process
11: -- : dep aeson
12: module Omni.Jr.Web.Handlers
13:   ( API,
14:     server,
15:     api,
16:     streamAgentEvents,
17:   )
18: where
19: 
20: import Alpha
21: import qualified Control.Concurrent as Concurrent
22: import qualified Data.Aeson as Aeson
23: import qualified Data.List as List
24: import qualified Data.Text as Text
25: import qualified Data.Text.Lazy as LazyText
26: import Data.Time (getCurrentTime)
27: import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
28: import qualified Omni.Fact as Fact
29: import qualified Omni.Jr.Web.Style as Style
30: import Omni.Jr.Web.Types
31: import qualified Omni.Task.Core as TaskCore
32: import Servant
33: import qualified Servant.HTML.Lucid as Lucid
34: import qualified Servant.Types.SourceT as Source
35: import qualified System.Exit as Exit
36: import qualified System.Process as Process
37: 
38: type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent)
39: 
40: type API =
41:   QueryParam "range" Text :> Get '[Lucid.HTML] HomePage
42:     :<|> "style.css" :> Get '[CSS] LazyText.Text
43:     :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage
44:     :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage
45:     :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage
46:     :<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
47:     :<|> "tasks"
48:       :> QueryParam "status" Text
49:       :> QueryParam "priority" Text
50:       :> QueryParam "namespace" Text
51:       :> QueryParam "type" Text
52:       :> QueryParam "sort" Text
53:       :> Get '[Lucid.HTML] TaskListPage
54:     :<|> "kb" :> Get '[Lucid.HTML] KBPage
55:     :<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
56:     :<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
57:     :<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
58:     :<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
59:     :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
60:     :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
61:     :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
62:     :<|> "tasks" :> Capture "id" Text :> "priority" :> ReqBody '[FormUrlEncoded] PriorityForm :> Post '[Lucid.HTML] PriorityBadgePartial
63:     :<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
64:     :<|> "tasks" :> Capture "id" Text :> "description" :> "edit" :> Get '[Lucid.HTML] DescriptionEditPartial
65:     :<|> "tasks" :> Capture "id" Text :> "description" :> ReqBody '[FormUrlEncoded] DescriptionForm :> Post '[Lucid.HTML] DescriptionViewPartial
66:     :<|> "tasks" :> Capture "id" Text :> "notes" :> ReqBody '[FormUrlEncoded] NotesForm :> PostRedirect
67:     :<|> "tasks" :> Capture "id" Text :> "comment" :> ReqBody '[FormUrlEncoded] CommentForm :> PostRedirect
68:     :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage
69:     :<|> "tasks" :> Capture "id" Text :> "diff" :> Capture "commit" Text :> Get '[Lucid.HTML] TaskDiffPage
70:     :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect
71:     :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect
72:     :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect
73:     :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial
74:     :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial
75:     :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial
76:     :<|> "partials"
77:       :> "task-list"
78:       :> QueryParam "status" Text
79:       :> QueryParam "priority" Text
80:       :> QueryParam "namespace" Text
81:       :> QueryParam "type" Text
82:       :> QueryParam "sort" Text
83:       :> Get '[Lucid.HTML] TaskListPartial
84:     :<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
85:     :<|> "partials" :> "task" :> Capture "id" Text :> "events" :> QueryParam "since" Int :> Get '[Lucid.HTML] AgentEventsPartial
86:     :<|> "tasks" :> Capture "id" Text :> "events" :> "stream" :> StreamGet NoFraming SSE (SourceIO ByteString)
87: 
88: api :: Proxy API
89: api = Proxy
90: 
91: server :: Server API
92: server =
93:   homeHandler
94:     :<|> styleHandler
95:     :<|> readyQueueHandler
96:     :<|> blockedHandler
97:     :<|> interventionHandler
98:     :<|> statsHandler
99:     :<|> taskListHandler
100:     :<|> kbHandler

100:     :<|> kbHandler
101:     :<|> factCreateHandler
102:     :<|> factDetailHandler
103:     :<|> factEditHandler
104:     :<|> factDeleteHandler
105:     :<|> epicsHandler
106:     :<|> taskDetailHandler
107:     :<|> taskStatusHandler
108:     :<|> taskPriorityHandler
109:     :<|> descriptionViewHandler
110:     :<|> descriptionEditHandler
111:     :<|> descriptionPostHandler
112:     :<|> taskNotesHandler
113:     :<|> taskCommentHandler
114:     :<|> taskReviewHandler
115:     :<|> taskDiffHandler
116:     :<|> taskAcceptHandler
117:     :<|> taskRejectHandler
118:     :<|> taskResetRetriesHandler
119:     :<|> recentActivityNewHandler
120:     :<|> recentActivityMoreHandler
121:     :<|> readyCountHandler
122:     :<|> taskListPartialHandler
123:     :<|> taskMetricsPartialHandler
124:     :<|> agentEventsPartialHandler
125:     :<|> taskEventsStreamHandler
126:   where
127:     styleHandler :: Servant.Handler LazyText.Text
128:     styleHandler = pure Style.css
129: 
130:     homeHandler :: Maybe Text -> Servant.Handler HomePage
131:     homeHandler maybeRangeText = do
132:       now <- liftIO getCurrentTime
133:       let range = parseTimeRange maybeRangeText
134:           maybeStart = getTimeRangeStart range now
135:       allTasks <- liftIO TaskCore.loadTasks
136:       let filteredTasks = case maybeStart of
137:             Nothing -> allTasks
138:             Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start]
139:           stats = TaskCore.computeTaskStatsFromList filteredTasks
140:       readyTasks <- liftIO TaskCore.getReadyTasks
141:       allActivities <- liftIO <| concat </ traverse (TaskCore.getActivitiesForTask <. TaskCore.taskId) allTasks
142:       let filteredActivities = case maybeStart of
143:             Nothing -> allActivities
144:             Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start]
145:           globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities
146:           sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks
147:           recentTasks = take 5 sortedTasks
148:           hasMoreRecent = length filteredTasks > 5
149:       pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now)
150: 

290: 
291:     taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial
292:     taskStatusHandler tid (StatusForm newStatus) = do
293:       liftIO <| TaskCore.updateTaskStatusWithActor tid newStatus [] TaskCore.Human
294:       pure (StatusBadgePartial newStatus tid)
295: 
296:     taskPriorityHandler :: Text -> PriorityForm -> Servant.Handler PriorityBadgePartial
297:     taskPriorityHandler tid (PriorityForm newPriority) = do
298:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskPriority = newPriority})
299:       pure (PriorityBadgePartial newPriority tid)
300: 
301:     descriptionViewHandler :: Text -> Servant.Handler DescriptionViewPartial
302:     descriptionViewHandler tid = do
303:       tasks <- liftIO TaskCore.loadTasks
304:       case TaskCore.findTask tid tasks of
305:         Nothing -> throwError err404
306:         Just task -> pure (DescriptionViewPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
307: 
308:     descriptionEditHandler :: Text -> Servant.Handler DescriptionEditPartial
309:     descriptionEditHandler tid = do
310:       tasks <- liftIO TaskCore.loadTasks
311:       case TaskCore.findTask tid tasks of
312:         Nothing -> throwError err404
313:         Just task -> pure (DescriptionEditPartial tid (TaskCore.taskDescription task) (TaskCore.taskType task == TaskCore.Epic))
314: 
315:     descriptionPostHandler :: Text -> DescriptionForm -> Servant.Handler DescriptionViewPartial
316:     descriptionPostHandler tid (DescriptionForm desc) = do
317:       let descText = Text.strip desc
318:       _ <- liftIO <| TaskCore.editTask tid (\t -> t {TaskCore.taskDescription = descText})
319:       tasks <- liftIO TaskCore.loadTasks
320:       case TaskCore.findTask tid tasks of

300: 
301: newtype RejectForm = RejectForm (Maybe Text)
302: 
303: instance FromForm RejectForm where
304:   fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
305: 
306: newtype StatusForm = StatusForm TaskCore.Status
307: 
308: instance FromForm StatusForm where
309:   fromForm form = do
310:     statusText <- parseUnique "status" form
311:     case readMaybe (Text.unpack statusText) of
312:       Just s -> Right (StatusForm s)
313:       Nothing -> Left "Invalid status"
314: 
315: newtype PriorityForm = PriorityForm TaskCore.Priority
316: 
317: instance FromForm PriorityForm where
318:   fromForm form = do
319:     priorityText <- parseUnique "priority" form
320:     case readMaybe (Text.unpack priorityText) of
321:       Just p -> Right (PriorityForm p)
322:       Nothing -> Left "Invalid priority"
323: 
324: newtype DescriptionForm = DescriptionForm Text
325: 

85: instance Lucid.ToHtml StatusBadgePartial where
86:   toHtmlRaw = Lucid.toHtml
87:   toHtml (StatusBadgePartial status tid) =
88:     statusBadgeWithForm status tid
89: 
90: instance Lucid.ToHtml PriorityBadgePartial where
91:   toHtmlRaw = Lucid.toHtml
92:   toHtml (PriorityBadgePartial priority tid) =
93:     priorityBadgeWithForm priority tid
94: 
95: instance Lucid.ToHtml TaskListPartial where
96:   toHtmlRaw = Lucid.toHtml
97:   toHtml (TaskListPartial tasks) =
98:     if null tasks
99:       then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks match the current filters."
100:       else Lucid.div_ [Lucid.class_ "list-group"] <| traverse_ renderListGroupItem tasks
101: 
102: instance Lucid.ToHtml TaskMetricsPartial where
103:   toHtmlRaw = Lucid.toHtml
104:   toHtml (TaskMetricsPartial _tid activities maybeRetry now) =
105:     let runningActs = filter (\a -> TaskCore.activityStage a == TaskCore.Running) activities

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE NoImplicitPrelude #-}
4: 
5: -- : dep lucid
6: -- : dep servant-lucid
7: module Omni.Jr.Web.Components
8:   ( -- * Time formatting
9:     formatRelativeTime,
10:     relativeText,
11:     formatExactTimestamp,
12:     renderRelativeTimestamp,
13: 
14:     -- * Small components
15:     metaSep,
16: 
17:     -- * Page layout
18:     pageHead,
19:     pageBody,
20:     pageBodyWithCrumbs,
21:     navbar,
22: 
23:     -- * JavaScript
24:     navbarDropdownJs,
25:     statusDropdownJs,
26:     priorityDropdownJs,
27:     liveToggleJs,
28: 
29:     -- * Breadcrumbs
30:     Breadcrumb (..),
31:     Breadcrumbs,
32:     renderBreadcrumbs,
33:     getAncestors,
34:     taskBreadcrumbs,
35: 
36:     -- * Badges
37:     statusBadge,
38:     complexityBadge,
39:     statusBadgeWithForm,
40:     clickableBadge,
41:     statusDropdownOptions,
42:     statusOption,
43:     priorityBadgeWithForm,
44:     clickablePriorityBadge,
45:     priorityDropdownOptions,
46:     priorityOption,
47: 
48:     -- * Sorting
49:     sortDropdown,
50:     sortOption,

1: {-# LANGUAGE DataKinds #-}
2: {-# LANGUAGE OverloadedStrings #-}
3: {-# LANGUAGE NoImplicitPrelude #-}
4: 
5: -- : dep servant-server
6: -- : dep lucid
7: -- : dep http-api-data
8: -- : dep aeson
9: module Omni.Jr.Web.Types
10:   ( TaskFilters (..),
11:     TimeRange (..),
12:     SortOrder (..),
13:     parseSortOrder,
14:     sortOrderToParam,
15:     sortOrderLabel,
16:     sortTasks,
17:     parseTimeRange,
18:     timeRangeToParam,
19:     getTimeRangeStart,
20:     startOfDay,
21:     startOfWeek,
22:     addDays,
23:     fromGregorian,
24:     daysSinceEpoch,
25:     startOfMonth,
26:     computeMetricsFromActivities,
27:     HomePage (..),
28:     ReadyQueuePage (..),
29:     BlockedPage (..),
30:     InterventionPage (..),
31:     TaskListPage (..),
32:     TaskDetailPage (..),
33:     GitCommit (..),
34:     TaskReviewPage (..),
35:     ReviewInfo (..),
36:     TaskDiffPage (..),
37:     StatsPage (..),
38:     KBPage (..),
39:     FactDetailPage (..),
40:     EpicsPage (..),
41:     RecentActivityNewPartial (..),
42:     RecentActivityMorePartial (..),
43:     ReadyCountPartial (..),
44:     StatusBadgePartial (..),
45:     PriorityBadgePartial (..),
46:     TaskListPartial (..),
47:     TaskMetricsPartial (..),
48:     AgentEventsPartial (..),
49:     DescriptionViewPartial (..),
50:     DescriptionEditPartial (..),
51:     FactEditForm (..),
52:     FactCreateForm (..),
53:     RejectForm (..),
54:     StatusForm (..),
55:     PriorityForm (..),
56:     DescriptionForm (..),
57:     NotesForm (..),
58:     CommentForm (..),
59:     Breadcrumb (..),
60:     Breadcrumbs,
61:     CSS,
62:     SSE,
63:   )
64: where
65: 
66: import Alpha
67: import qualified Data.ByteString as BS
68: import qualified Data.ByteString.Lazy as LBS
69: import qualified Data.List as List
70: import qualified Data.Text as Text
71: import qualified Data.Text.Lazy as LazyText
72: import qualified Data.Text.Lazy.Encoding as LazyText
73: import Data.Time (Day, DayOfWeek (..), UTCTime (..), dayOfWeek, diffUTCTime, toGregorian)
74: import qualified Omni.Task.Core as TaskCore
75: import Servant (Accept (..), MimeRender (..))
76: import Web.FormUrlEncoded (FromForm (..), lookupUnique, parseUnique)
77: 
78: data TaskFilters = TaskFilters
79:   { filterStatus :: Maybe TaskCore.Status,
80:     filterPriority :: Maybe TaskCore.Priority,

44:     StatusBadgePartial (..),
45:     PriorityBadgePartial (..),
46:     TaskListPartial (..),
47:     TaskMetricsPartial (..),
48:     AgentEventsPartial (..),
49:     DescriptionViewPartial (..),
50:     DescriptionEditPartial (..),
51:     FactEditForm (..),
52:     FactCreateForm (..),
53:     RejectForm (..),
54:     StatusForm (..),
55:     PriorityForm (..),
56:     DescriptionForm (..),
57:     NotesForm (..),
58:     CommentForm (..),
59:     Breadcrumb (..),
60:     Breadcrumbs,

285: data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool
286: 
287: newtype ReadyCountPartial = ReadyCountPartial Int
288: 
289: data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text
290: 
291: data PriorityBadgePartial = PriorityBadgePartial TaskCore.Priority Text
292: 
293: newtype TaskListPartial = TaskListPartial [TaskCore.Task]
294: 
295: data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime
296: 
297: data AgentEventsPartial = AgentEventsPartial Text [TaskCore.StoredEvent] Bool UTCTime
298: 
299: data DescriptionViewPartial = DescriptionViewPartial Text Text Bool
300: 
301: data DescriptionEditPartial = DescriptionEditPartial Text Text Bool
302: 
303: newtype RejectForm = RejectForm (Maybe Text)
304: 
305: instance FromForm RejectForm where
306:   fromForm form = Right (RejectForm (either (const Nothing) Just (lookupUnique "notes" form)))
307: 
308: newtype StatusForm = StatusForm TaskCore.Status
309: 
310: instance FromForm StatusForm where
311:   fromForm form = do
312:     statusText <- parseUnique "status" form
313:     case readMaybe (Text.unpack statusText) of
314:       Just s -> Right (StatusForm s)
315:       Nothing -> Left "Invalid status"
316: 
317: newtype PriorityForm = PriorityForm TaskCore.Priority
318: 
319: instance FromForm PriorityForm where
320:   fromForm form = do
321:     priorityText <- parseUnique "priority" form
322:     case readMaybe (Text.unpack priorityText) of
323:       Just p -> Right (PriorityForm p)
324:       Nothing -> Left "Invalid priority"
325: 
326: newtype DescriptionForm = DescriptionForm Text
327: 
328: instance FromForm DescriptionForm where
329:   fromForm form = do
330:     desc <- parseUnique "description" form

770:               Lucid.class_ optClass,
771:               Lucid.role_ "menuitem",
772:               Lucid.tabindex_ "-1",
773:               Lucid.makeAttribute "onkeydown" "handlePriorityMenuItemKeydown(event)"
774:             ]
775:             (Lucid.toHtml label)
776: 
777: -- * Task rendering
778: 
779: renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m ()
780: renderTaskCard t =
781:   Lucid.a_
782:     [ Lucid.class_ "task-card task-card-link",
783:       Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
784:     ]
785:     <| do
786:       Lucid.div_ [Lucid.class_ "task-header"] <| do
787:         Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))
788:         statusBadge (TaskCore.taskStatus t)
789:         Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t)))
790:       Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t))
791: 
792: renderBlockedTaskCard :: (Monad m) => (TaskCore.Task, Int) -> Lucid.HtmlT m ()
793: renderBlockedTaskCard (t, impact) =
794:   Lucid.a_
795:     [ Lucid.class_ "task-card task-card-link",
796:       Lucid.href_ ("/tasks/" <> TaskCore.taskId t)
797:     ]
798:     <| do
799:       Lucid.div_ [Lucid.class_ "task-header"] <| do
800:         Lucid.span_ [Lucid.class_ "task-id"] (Lucid.toHtml (TaskCore.taskId t))

298: priorityDropdownJs :: Text
299: priorityDropdownJs =
300:   Text.unlines
301:     [ "function togglePriorityDropdown(el) {",
302:       "  var container = el.parentElement;",
303:       "  var isOpen = container.classList.toggle('open');",
304:       "  el.setAttribute('aria-expanded', isOpen);",
305:       "  if (isOpen) {",
306:       "    var firstItem = container.querySelector('[role=\"menuitem\"]');",
307:       "    if (firstItem) firstItem.focus();",
308:       "  }",
309:       "}",
310:       "",
311:       "function closePriorityDropdown(container) {",
312:       "  container.classList.remove('open');",
313:       "  var badge = container.querySelector('[role=\"button\"]');",
314:       "  if (badge) {",
315:       "    badge.setAttribute('aria-expanded', 'false');",
316:       "    badge.focus();",
317:       "  }",
318:       "}",
319:       "",
320:       "function handlePriorityKeydown(event, el) {",
321:       "  if (event.key === 'Enter' || event.key === ' ') {",
322:       "    event.preventDefault();",
323:       "    togglePriorityDropdown(el);",
324:       "  } else if (event.key === 'Escape') {",
325:       "    closePriorityDropdown(el.parentElement);",
326:       "  } else if (event.key === 'ArrowDown') {",
327:       "    event.preventDefault();",
328:       "    var container = el.parentElement;",
329:       "    if (!container.classList.contains('open')) {",
330:       "      togglePriorityDropdown(el);",
331:       "    } else {",
332:       "      var firstItem = container.querySelector('[role=\"menuitem\"]');",
333:       "      if (firstItem) firstItem.focus();",
334:       "    }",
335:       "  }",
336:       "}",
337:       "",
338:       "function handlePriorityMenuItemKeydown(event) {",
339:       "  var container = event.target.closest('.priority-badge-dropdown');",
340:       "  var items = container.querySelectorAll('[role=\"menuitem\"]');",
341:       "  var currentIndex = Array.from(items).indexOf(event.target);",
342:       "  ",
343:       "  if (event.key === 'ArrowDown') {",
344:       "    event.preventDefault();",
345:       "    var next = (currentIndex + 1) % items.length;",
346:       "    items[next].focus();",
347:       "  } else if (event.key === 'ArrowUp') {",
348:       "    event.preventDefault();",
349:       "    var prev = (currentIndex - 1 + items.length) % items.length;",
350:       "    items[prev].focus();",
351:       "  } else if (event.key === 'Escape') {",
352:       "    event.preventDefault();",
353:       "    closePriorityDropdown(container);",
354:       "  } else if (event.key === 'Tab') {",
355:       "    closePriorityDropdown(container);",
356:       "  }",
357:       "}",
358:       "",
359:       "document.addEventListener('click', function(e) {",
360:       "  var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
361:       "  dropdowns.forEach(function(d) {",
362:       "    if (!d.contains(e.target)) {",
363:       "      closePriorityDropdown(d);",
364:       "    }",
365:       "  });",
366:       "});"
367:     ]
368: 
369: liveToggleJs :: Text
370: liveToggleJs =
371:   Text.unlines
372:     [ "var liveUpdatesEnabled = true;",
373:       "var autoscrollEnabled = true;",
374:       "",
375:       "function toggleLiveUpdates() {",
376:       "  liveUpdatesEnabled = !liveUpdatesEnabled;",
377:       "  var btn = document.getElementById('live-toggle');",
378:       "  if (btn) {",
379:       "    btn.classList.toggle('timeline-live-paused', !liveUpdatesEnabled);",
380:       "  }",

360:       "  var dropdowns = document.querySelectorAll('.priority-badge-dropdown.open');",
361:       "  dropdowns.forEach(function(d) {",
362:       "    if (!d.contains(e.target)) {",
363:       "      closePriorityDropdown(d);",
364:       "    }",
365:       "  });",
366:       "});"
367:     ]
368: 
369: liveToggleJs :: Text
370: liveToggleJs =