From d2f016ecdf4a5cf1eb5d8922a7a00d99f5861091 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Thu, 27 Nov 2025 16:31:25 -0500 Subject: Add dropdown menus Tasks (Ready, Blocked, Intervention, All), Plans (Epics, KB). Task-Id: t-154.2 --- Omni/Jr/Web.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 72 insertions(+), 11 deletions(-) (limited to 'Omni/Jr/Web.hs') diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 46511a0..3327b26 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -42,7 +42,8 @@ defaultPort = 8080 data TaskFilters = TaskFilters { filterStatus :: Maybe TaskCore.Status, filterPriority :: Maybe TaskCore.Priority, - filterNamespace :: Maybe Text + filterNamespace :: Maybe Text, + filterType :: Maybe TaskCore.TaskType } deriving (Show, Eq) @@ -57,7 +58,9 @@ type API = :> QueryParam "status" Text :> QueryParam "priority" Text :> QueryParam "namespace" Text + :> QueryParam "type" Text :> Get '[Lucid.HTML] TaskListPage + :<|> "kb" :> Get '[Lucid.HTML] KBPage :<|> "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 @@ -74,6 +77,7 @@ type API = :> 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 @@ -124,6 +128,8 @@ data TaskDiffPage data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) +newtype KBPage = KBPage [TaskCore.Task] + newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task] newtype ReadyCountPartial = ReadyCountPartial Int @@ -185,10 +191,18 @@ navbar = Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-brand"] "Jr" Lucid.div_ [Lucid.class_ "navbar-links"] <| do Lucid.a_ [Lucid.href_ "/", Lucid.class_ "navbar-link"] "Dashboard" - Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "navbar-link"] "Tasks" - Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "navbar-link"] "Ready" - Lucid.a_ [Lucid.href_ "/blocked", Lucid.class_ "navbar-link"] "Blocked" - Lucid.a_ [Lucid.href_ "/intervention", Lucid.class_ "navbar-link"] "Intervention" + 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_ "/tasks?type=Epic", 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 () @@ -337,6 +351,36 @@ instance Lucid.ToHtml InterventionPage where 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 tasks) = + 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"] "Epic design documents and project knowledge." + if null tasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No epics with designs yet." + else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderEpicCard tasks + where + renderEpicCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () + renderEpicCard 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.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) + case TaskCore.taskDescription t of + Nothing -> pure () + Just desc -> + Lucid.p_ [Lucid.class_ "kb-preview"] (Lucid.toHtml (Text.take 200 desc <> "...")) + instance Lucid.ToHtml TaskListPage where toHtmlRaw = Lucid.toHtml toHtml (TaskListPage tasks filters) = @@ -1188,6 +1232,7 @@ server = :<|> interventionHandler :<|> statsHandler :<|> taskListHandler + :<|> kbHandler :<|> taskDetailHandler :<|> taskStatusHandler :<|> taskDescriptionHandler @@ -1237,21 +1282,31 @@ server = stats <- liftIO <| TaskCore.getTaskStats epicId pure (StatsPage stats epicId) - taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage - taskListHandler maybeStatusText maybePriorityText maybeNamespace = do + taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage + taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do allTasks <- liftIO TaskCore.loadTasks let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText maybePriority = parsePriority =<< emptyToNothing maybePriorityText - filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) + maybeType = parseTaskType =<< emptyToNothing maybeTypeText + filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType filteredTasks = applyFilters filters allTasks pure (TaskListPage filteredTasks filters) + kbHandler :: Servant.Handler KBPage + kbHandler = do + allTasks <- liftIO TaskCore.loadTasks + let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks + pure (KBPage epicTasks) + 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 @@ -1263,6 +1318,7 @@ server = matchesStatus task && matchesPriority task && matchesNamespace task + && matchesType task matchesStatus task = case filterStatus filters of Nothing -> True @@ -1278,6 +1334,10 @@ server = 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 tasks <- liftIO TaskCore.loadTasks @@ -1366,12 +1426,13 @@ server = readyTasks <- liftIO TaskCore.getReadyTasks pure (ReadyCountPartial (length readyTasks)) - taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial - taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace = do + 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 - filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) + maybeType = parseTaskType =<< emptyToNothing maybeTypeText + filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType filteredTasks = applyFilters filters allTasks pure (TaskListPartial filteredTasks) -- cgit v1.2.3