{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} -- : dep warp -- : dep servant-server -- : dep lucid -- : dep servant-lucid -- : dep http-api-data module Omni.Jr.Web ( run, defaultPort, ) where import Alpha import qualified Data.List as List import qualified Data.Text as Text import qualified Lucid import qualified Network.Wai.Handler.Warp as Warp import qualified Omni.Task.Core as TaskCore import Servant import qualified Servant.HTML.Lucid as Lucid import Web.FormUrlEncoded (FromForm (..), parseUnique) type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Text] NoContent) defaultPort :: Warp.Port defaultPort = 8080 type API = Get '[Lucid.HTML] HomePage :<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage :<|> "tasks" :> Get '[Lucid.HTML] TaskListPage :<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage :<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> PostRedirect data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] newtype ReadyQueuePage = ReadyQueuePage [TaskCore.Task] newtype TaskListPage = TaskListPage [TaskCore.Task] data TaskDetailPage = TaskDetailFound TaskCore.Task [TaskCore.Task] | TaskDetailNotFound Text newtype StatusForm = StatusForm TaskCore.Status instance FromForm StatusForm where fromForm form = do statusText <- parseUnique "status" form case readMaybe (Text.unpack statusText) of Just s -> Right (StatusForm s) Nothing -> Left "Invalid status" instance Lucid.ToHtml HomePage where toHtmlRaw = Lucid.toHtml toHtml (HomePage stats readyTasks recentTasks) = Lucid.doctypehtml_ <| do Lucid.head_ <| do Lucid.title_ "Jr Dashboard" Lucid.meta_ [Lucid.charset_ "utf-8"] Lucid.meta_ [ Lucid.name_ "viewport", Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.style_ homeStyles Lucid.body_ <| do Lucid.h1_ "Jr Dashboard" Lucid.div_ [Lucid.class_ "actions"] <| do Lucid.a_ [Lucid.href_ "/tasks", Lucid.class_ "action-btn"] "View All Tasks" Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "action-btn action-btn-primary"] "View Ready Queue" Lucid.h2_ "Task Status" Lucid.div_ [Lucid.class_ "stats-grid"] <| do statCard "Open" (TaskCore.openTasks stats) "badge-open" statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" statCard "Review" (TaskCore.reviewTasks stats) "badge-review" statCard "Approved" (TaskCore.approvedTasks stats) "badge-approved" statCard "Done" (TaskCore.doneTasks stats) "badge-done" Lucid.h2_ <| do "Ready Queue " Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)") if null readyTasks then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work." else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard (take 5 readyTasks) Lucid.h2_ "Recent Activity" if null recentTasks then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." else Lucid.div_ [Lucid.class_ "task-list"] <| traverse_ renderTaskCard recentTasks where statCard :: (Monad m) => Text -> Int -> Text -> Lucid.HtmlT m () statCard label count badgeClass = Lucid.div_ [Lucid.class_ ("stat-card " <> badgeClass)] <| do Lucid.div_ [Lucid.class_ "stat-count"] (Lucid.toHtml (tshow count)) Lucid.div_ [Lucid.class_ "stat-label"] (Lucid.toHtml label) renderTaskCard :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () renderTaskCard t = Lucid.div_ [Lucid.class_ "task-card"] <| do Lucid.div_ [Lucid.class_ "task-header"] <| do Lucid.a_ [ Lucid.class_ "task-id", Lucid.href_ ("/tasks/" <> TaskCore.taskId t) ] (Lucid.toHtml (TaskCore.taskId t)) statusBadge (TaskCore.taskStatus t) Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t))) Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m () statusBadge status = let (cls, label) = case status of TaskCore.Open -> ("badge badge-open", "Open") TaskCore.InProgress -> ("badge badge-inprogress", "In Progress") TaskCore.Review -> ("badge badge-review", "Review") TaskCore.Approved -> ("badge badge-approved", "Approved") TaskCore.Done -> ("badge badge-done", "Done") in Lucid.span_ [Lucid.class_ cls] label homeStyles :: Text homeStyles = "* { box-sizing: border-box; } \ \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \ \ margin: 0; padding: 16px; background: #f5f5f5; max-width: 900px; } \ \h1 { margin: 0 0 16px 0; } \ \h2 { margin: 24px 0 12px 0; color: #374151; font-size: 18px; } \ \.actions { display: flex; flex-wrap: wrap; gap: 8px; margin-bottom: 16px; } \ \.action-btn { display: inline-block; padding: 10px 16px; background: white; \ \ border: 1px solid #d1d5db; border-radius: 6px; color: #374151; \ \ text-decoration: none; font-size: 14px; font-weight: 500; } \ \.action-btn:hover { background: #f9fafb; } \ \.action-btn-primary { background: #0066cc; color: white; border-color: #0066cc; } \ \.action-btn-primary:hover { background: #0052a3; } \ \.stats-grid { display: grid; grid-template-columns: repeat(auto-fit, minmax(100px, 1fr)); gap: 12px; } \ \.stat-card { background: white; border-radius: 8px; padding: 16px; text-align: center; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.stat-count { font-size: 28px; font-weight: 700; } \ \.stat-label { font-size: 12px; color: #6b7280; margin-top: 4px; } \ \.stat-card.badge-open { border-left: 4px solid #f59e0b; } \ \.stat-card.badge-open .stat-count { color: #92400e; } \ \.stat-card.badge-inprogress { border-left: 4px solid #3b82f6; } \ \.stat-card.badge-inprogress .stat-count { color: #1e40af; } \ \.stat-card.badge-review { border-left: 4px solid #8b5cf6; } \ \.stat-card.badge-review .stat-count { color: #6b21a8; } \ \.stat-card.badge-approved { border-left: 4px solid #10b981; } \ \.stat-card.badge-approved .stat-count { color: #065f46; } \ \.stat-card.badge-done { border-left: 4px solid #10b981; } \ \.stat-card.badge-done .stat-count { color: #065f46; } \ \.ready-link { font-size: 14px; color: #0066cc; text-decoration: none; } \ \.ready-link:hover { text-decoration: underline; } \ \.empty-msg { color: #6b7280; font-style: italic; } \ \.task-list { display: flex; flex-direction: column; gap: 8px; } \ \.task-card { background: white; border-radius: 8px; padding: 16px; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.task-header { display: flex; flex-wrap: wrap; align-items: center; gap: 8px; margin-bottom: 8px; } \ \.task-id { font-family: monospace; color: #0066cc; text-decoration: none; \ \ font-size: 14px; padding: 4px 0; } \ \.task-id:hover { text-decoration: underline; } \ \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \ \ font-size: 12px; font-weight: 500; } \ \.badge-open { background: #fef3c7; color: #92400e; } \ \.badge-inprogress { background: #dbeafe; color: #1e40af; } \ \.badge-review { background: #ede9fe; color: #6b21a8; } \ \.badge-approved { background: #d1fae5; color: #065f46; } \ \.badge-done { background: #d1fae5; color: #065f46; } \ \.priority { font-size: 12px; color: #6b7280; } \ \.task-title { font-size: 16px; margin: 0; }" instance Lucid.ToHtml ReadyQueuePage where toHtmlRaw = Lucid.toHtml toHtml (ReadyQueuePage tasks) = Lucid.doctypehtml_ <| do Lucid.head_ <| do Lucid.title_ "Ready Queue - Jr Web UI" Lucid.meta_ [Lucid.charset_ "utf-8"] Lucid.meta_ [ Lucid.name_ "viewport", Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.style_ readyStyles Lucid.body_ <| do Lucid.p_ <| Lucid.a_ [Lucid.href_ "/"] "← Back to Dashboard" Lucid.h1_ <| do "Ready Queue " Lucid.span_ [Lucid.class_ "count-badge"] (Lucid.toHtml (tshow (length 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_ renderTask tasks where readyStyles :: Text readyStyles = "* { box-sizing: border-box; } \ \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \ \ margin: 0; padding: 16px; background: #f5f5f5; max-width: 900px; } \ \h1 { margin: 16px 0; } \ \.count-badge { background: #0066cc; color: white; padding: 4px 10px; \ \ border-radius: 12px; font-size: 14px; vertical-align: middle; } \ \.empty-msg { color: #6b7280; font-style: italic; } \ \.task-list { display: flex; flex-direction: column; gap: 8px; } \ \.task-card { background: white; border-radius: 8px; padding: 16px; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.task-header { display: flex; flex-wrap: wrap; align-items: center; gap: 8px; margin-bottom: 8px; } \ \.task-id { font-family: monospace; color: #0066cc; text-decoration: none; \ \ font-size: 14px; padding: 4px 0; } \ \.task-id:hover { text-decoration: underline; } \ \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \ \ font-size: 12px; font-weight: 500; } \ \.badge-open { background: #fef3c7; color: #92400e; } \ \.badge-inprogress { background: #dbeafe; color: #1e40af; } \ \.badge-review { background: #ede9fe; color: #6b21a8; } \ \.badge-approved { background: #d1fae5; color: #065f46; } \ \.badge-done { background: #d1fae5; color: #065f46; } \ \.priority { font-size: 12px; color: #6b7280; } \ \.task-title { font-size: 16px; margin: 0; }" renderTask :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () renderTask t = Lucid.div_ [Lucid.class_ "task-card"] <| do Lucid.div_ [Lucid.class_ "task-header"] <| do Lucid.a_ [ Lucid.class_ "task-id", Lucid.href_ ("/tasks/" <> TaskCore.taskId t) ] (Lucid.toHtml (TaskCore.taskId t)) statusBadge (TaskCore.taskStatus t) Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t))) Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m () statusBadge status = let (cls, label) = case status of TaskCore.Open -> ("badge badge-open", "Open") TaskCore.InProgress -> ("badge badge-inprogress", "In Progress") TaskCore.Review -> ("badge badge-review", "Review") TaskCore.Approved -> ("badge badge-approved", "Approved") TaskCore.Done -> ("badge badge-done", "Done") in Lucid.span_ [Lucid.class_ cls] label instance Lucid.ToHtml TaskListPage where toHtmlRaw = Lucid.toHtml toHtml (TaskListPage tasks) = Lucid.doctypehtml_ <| do Lucid.head_ <| do Lucid.title_ "Tasks - Jr Web UI" Lucid.meta_ [Lucid.charset_ "utf-8"] Lucid.meta_ [ Lucid.name_ "viewport", Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.style_ styles Lucid.body_ <| do Lucid.h1_ "Tasks" Lucid.div_ [Lucid.class_ "task-list"] <| do traverse_ renderTask tasks where styles :: Text styles = "* { box-sizing: border-box; } \ \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \ \ margin: 0; padding: 16px; background: #f5f5f5; } \ \h1 { margin: 0 0 16px 0; } \ \.task-list { display: flex; flex-direction: column; gap: 8px; } \ \.task-card { background: white; border-radius: 8px; padding: 16px; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.task-header { display: flex; flex-wrap: wrap; align-items: center; gap: 8px; margin-bottom: 8px; } \ \.task-id { font-family: monospace; color: #0066cc; text-decoration: none; \ \ font-size: 14px; padding: 4px 0; } \ \.task-id:hover { text-decoration: underline; } \ \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \ \ font-size: 12px; font-weight: 500; } \ \.badge-open { background: #fef3c7; color: #92400e; } \ \.badge-inprogress { background: #dbeafe; color: #1e40af; } \ \.badge-review { background: #ede9fe; color: #6b21a8; } \ \.badge-approved { background: #d1fae5; color: #065f46; } \ \.badge-done { background: #d1fae5; color: #065f46; } \ \.priority { font-size: 12px; color: #6b7280; } \ \.task-title { font-size: 16px; margin: 0; }" renderTask :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () renderTask t = Lucid.div_ [Lucid.class_ "task-card"] <| do Lucid.div_ [Lucid.class_ "task-header"] <| do Lucid.a_ [ Lucid.class_ "task-id", Lucid.href_ ("/tasks/" <> TaskCore.taskId t) ] (Lucid.toHtml (TaskCore.taskId t)) statusBadge (TaskCore.taskStatus t) Lucid.span_ [Lucid.class_ "priority"] (Lucid.toHtml (tshow (TaskCore.taskPriority t))) Lucid.p_ [Lucid.class_ "task-title"] (Lucid.toHtml (TaskCore.taskTitle t)) statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m () statusBadge status = let (cls, label) = case status of TaskCore.Open -> ("badge badge-open", "Open") TaskCore.InProgress -> ("badge badge-inprogress", "In Progress") TaskCore.Review -> ("badge badge-review", "Review") TaskCore.Approved -> ("badge badge-approved", "Approved") TaskCore.Done -> ("badge badge-done", "Done") in Lucid.span_ [Lucid.class_ cls] label instance Lucid.ToHtml TaskDetailPage where toHtmlRaw = Lucid.toHtml toHtml (TaskDetailNotFound tid) = Lucid.doctypehtml_ <| do Lucid.head_ <| do Lucid.title_ "Task Not Found - Jr Web UI" Lucid.meta_ [Lucid.charset_ "utf-8"] Lucid.meta_ [ Lucid.name_ "viewport", Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.style_ detailStyles Lucid.body_ <| do Lucid.h1_ "Task Not Found" Lucid.p_ <| do "The task " Lucid.code_ (Lucid.toHtml tid) " could not be found." Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "← Back to Tasks" toHtml (TaskDetailFound task allTasks) = Lucid.doctypehtml_ <| do Lucid.head_ <| do Lucid.title_ <| Lucid.toHtml (TaskCore.taskId task <> " - Jr Web UI") Lucid.meta_ [Lucid.charset_ "utf-8"] Lucid.meta_ [ Lucid.name_ "viewport", Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.style_ detailStyles Lucid.body_ <| do Lucid.p_ <| Lucid.a_ [Lucid.href_ "/tasks"] "← Back to Tasks" Lucid.h1_ <| Lucid.toHtml (TaskCore.taskTitle task) Lucid.div_ [Lucid.class_ "task-detail"] <| do Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "ID:" Lucid.code_ [Lucid.class_ "detail-value"] (Lucid.toHtml (TaskCore.taskId task)) Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Type:" Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskType task))) Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Status:" Lucid.span_ [Lucid.class_ "detail-value"] <| statusBadge (TaskCore.taskStatus task) Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Priority:" Lucid.span_ [Lucid.class_ "detail-value"] <| do Lucid.toHtml (tshow (TaskCore.taskPriority task)) Lucid.span_ [Lucid.class_ "priority-desc"] (Lucid.toHtml (priorityDesc (TaskCore.taskPriority task))) case TaskCore.taskNamespace task of Nothing -> pure () Just ns -> Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Namespace:" Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml ns) case TaskCore.taskParent task of Nothing -> pure () Just pid -> Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Parent:" Lucid.a_ [Lucid.href_ ("/tasks/" <> pid), Lucid.class_ "detail-value task-link"] (Lucid.toHtml pid) Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Created:" Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (TaskCore.taskCreatedAt task))) Lucid.div_ [Lucid.class_ "detail-row"] <| do Lucid.span_ [Lucid.class_ "detail-label"] "Updated:" Lucid.span_ [Lucid.class_ "detail-value"] (Lucid.toHtml (tshow (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.taskDescription task of Nothing -> pure () Just desc -> Lucid.div_ [Lucid.class_ "detail-section"] <| do Lucid.h3_ "Description" Lucid.pre_ [Lucid.class_ "description"] (Lucid.toHtml desc) let children = filter (maybe False (TaskCore.matchesId (TaskCore.taskId task)) <. TaskCore.taskParent) allTasks unless (null children) <| do Lucid.div_ [Lucid.class_ "detail-section"] <| do Lucid.h3_ "Child Tasks" Lucid.ul_ [Lucid.class_ "child-list"] <| do traverse_ renderChild children Lucid.div_ [Lucid.class_ "status-form"] <| do Lucid.h3_ "Update Status" Lucid.form_ [Lucid.method_ "POST", Lucid.action_ ("/tasks/" <> TaskCore.taskId task <> "/status")] <| do Lucid.select_ [Lucid.name_ "status", Lucid.class_ "status-select"] <| do statusOption TaskCore.Open (TaskCore.taskStatus task) statusOption TaskCore.InProgress (TaskCore.taskStatus task) statusOption TaskCore.Review (TaskCore.taskStatus task) statusOption TaskCore.Approved (TaskCore.taskStatus task) statusOption TaskCore.Done (TaskCore.taskStatus task) Lucid.button_ [Lucid.type_ "submit", Lucid.class_ "submit-btn"] "Submit" where priorityDesc :: TaskCore.Priority -> Text priorityDesc p = case p of TaskCore.P0 -> " (Critical)" TaskCore.P1 -> " (High)" TaskCore.P2 -> " (Medium)" TaskCore.P3 -> " (Low)" TaskCore.P4 -> " (Backlog)" statusBadge :: (Monad m) => TaskCore.Status -> Lucid.HtmlT m () statusBadge status = let (cls, label) = case status of TaskCore.Open -> ("badge badge-open", "Open") TaskCore.InProgress -> ("badge badge-inprogress", "In Progress") TaskCore.Review -> ("badge badge-review", "Review") TaskCore.Approved -> ("badge badge-approved", "Approved") TaskCore.Done -> ("badge badge-done", "Done") in Lucid.span_ [Lucid.class_ cls] label statusOption :: (Monad m) => TaskCore.Status -> TaskCore.Status -> Lucid.HtmlT m () statusOption opt current = let attrs = if opt == current then [Lucid.value_ (tshow opt), Lucid.selected_ "selected"] else [Lucid.value_ (tshow opt)] in Lucid.option_ attrs (Lucid.toHtml (tshow opt)) renderDependency :: (Monad m) => TaskCore.Dependency -> Lucid.HtmlT m () renderDependency dep = Lucid.li_ <| do Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.depId dep), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.depId dep)) Lucid.span_ [Lucid.class_ "dep-type"] <| Lucid.toHtml (" [" <> tshow (TaskCore.depType dep) <> "]") renderChild :: (Monad m) => TaskCore.Task -> Lucid.HtmlT m () renderChild child = Lucid.li_ <| do Lucid.a_ [Lucid.href_ ("/tasks/" <> TaskCore.taskId child), Lucid.class_ "task-link"] (Lucid.toHtml (TaskCore.taskId child)) Lucid.span_ [Lucid.class_ "child-title"] <| Lucid.toHtml (" - " <> TaskCore.taskTitle child) Lucid.span_ [Lucid.class_ "child-status"] <| Lucid.toHtml (" [" <> tshow (TaskCore.taskStatus child) <> "]") detailStyles :: Text detailStyles = "* { box-sizing: border-box; } \ \body { font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, sans-serif; \ \ margin: 0; padding: 16px; background: #f5f5f5; max-width: 800px; } \ \h1 { margin: 16px 0; } \ \h3 { margin: 16px 0 8px 0; color: #374151; } \ \.task-detail { background: white; border-radius: 8px; padding: 16px; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.detail-row { display: flex; padding: 8px 0; border-bottom: 1px solid #e5e7eb; } \ \.detail-row:last-child { border-bottom: none; } \ \.detail-label { font-weight: 600; width: 120px; color: #6b7280; } \ \.detail-value { flex: 1; } \ \.detail-section { margin-top: 16px; padding-top: 16px; border-top: 1px solid #e5e7eb; } \ \.task-link { color: #0066cc; text-decoration: none; font-family: monospace; } \ \.task-link:hover { text-decoration: underline; } \ \.dep-list, .child-list { margin: 8px 0; padding-left: 20px; } \ \.dep-list li, .child-list li { margin: 4px 0; } \ \.dep-type { color: #6b7280; font-size: 14px; } \ \.child-title { color: #374151; } \ \.child-status { color: #6b7280; font-size: 14px; } \ \.description { background: #f9fafb; padding: 12px; border-radius: 4px; \ \ font-family: monospace; font-size: 14px; white-space: pre-wrap; margin: 0; } \ \.priority-desc { color: #6b7280; margin-left: 4px; } \ \.badge { display: inline-block; padding: 4px 8px; border-radius: 4px; \ \ font-size: 12px; font-weight: 500; } \ \.badge-open { background: #fef3c7; color: #92400e; } \ \.badge-inprogress { background: #dbeafe; color: #1e40af; } \ \.badge-review { background: #ede9fe; color: #6b21a8; } \ \.badge-approved { background: #d1fae5; color: #065f46; } \ \.badge-done { background: #d1fae5; color: #065f46; } \ \.status-form { margin-top: 24px; background: white; border-radius: 8px; padding: 16px; \ \ box-shadow: 0 1px 3px rgba(0,0,0,0.1); } \ \.status-select { padding: 8px 12px; border: 1px solid #d1d5db; border-radius: 4px; \ \ font-size: 14px; margin-right: 8px; } \ \.submit-btn { padding: 8px 16px; background: #0066cc; color: white; border: none; \ \ border-radius: 4px; font-size: 14px; cursor: pointer; } \ \.submit-btn:hover { background: #0052a3; }" api :: Proxy API api = Proxy server :: Server API server = homeHandler :<|> readyQueueHandler :<|> taskListHandler :<|> taskDetailHandler :<|> taskStatusHandler where homeHandler :: Servant.Handler HomePage homeHandler = do stats <- liftIO <| TaskCore.getTaskStats Nothing readyTasks <- liftIO TaskCore.getReadyTasks allTasks <- liftIO TaskCore.loadTasks let recentTasks = take 5 <| List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks pure (HomePage stats readyTasks recentTasks) readyQueueHandler :: Servant.Handler ReadyQueuePage readyQueueHandler = do readyTasks <- liftIO TaskCore.getReadyTasks pure (ReadyQueuePage readyTasks) taskListHandler :: Servant.Handler TaskListPage taskListHandler = do tasks <- liftIO TaskCore.loadTasks pure (TaskListPage tasks) taskDetailHandler :: Text -> Servant.Handler TaskDetailPage taskDetailHandler tid = do tasks <- liftIO TaskCore.loadTasks case TaskCore.findTask tid tasks of Nothing -> pure (TaskDetailNotFound tid) Just task -> pure (TaskDetailFound task tasks) taskStatusHandler :: Text -> StatusForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) taskStatusHandler tid (StatusForm newStatus) = do liftIO <| TaskCore.updateTaskStatus tid newStatus [] pure <| addHeader ("/tasks/" <> tid) NoContent app :: Application app = serve api server run :: Warp.Port -> IO () run port = do putText <| "Starting Jr web server on port " <> tshow port Warp.run port app