summaryrefslogtreecommitdiff
path: root/Omni/Jr
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Jr')
-rw-r--r--Omni/Jr/Web.hs158
-rw-r--r--Omni/Jr/Web/Style.hs57
2 files changed, 173 insertions, 42 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs
index 3380b93..ece96ed 100644
--- a/Omni/Jr/Web.hs
+++ b/Omni/Jr/Web.hs
@@ -93,6 +93,42 @@ data TaskFilters = TaskFilters
data TimeRange = Today | Week | Month | AllTime
deriving (Show, Eq)
+data SortOrder
+ = SortNewest
+ | SortOldest
+ | SortUpdated
+ | SortPriorityHigh
+ | SortPriorityLow
+ deriving (Show, Eq)
+
+parseSortOrder :: Maybe Text -> SortOrder
+parseSortOrder (Just "oldest") = SortOldest
+parseSortOrder (Just "updated") = SortUpdated
+parseSortOrder (Just "priority-high") = SortPriorityHigh
+parseSortOrder (Just "priority-low") = SortPriorityLow
+parseSortOrder _ = SortNewest
+
+sortOrderToParam :: SortOrder -> Text
+sortOrderToParam SortNewest = "newest"
+sortOrderToParam SortOldest = "oldest"
+sortOrderToParam SortUpdated = "updated"
+sortOrderToParam SortPriorityHigh = "priority-high"
+sortOrderToParam SortPriorityLow = "priority-low"
+
+sortOrderLabel :: SortOrder -> Text
+sortOrderLabel SortNewest = "Newest First"
+sortOrderLabel SortOldest = "Oldest First"
+sortOrderLabel SortUpdated = "Recently Updated"
+sortOrderLabel SortPriorityHigh = "Priority (High to Low)"
+sortOrderLabel SortPriorityLow = "Priority (Low to High)"
+
+sortTasks :: SortOrder -> [TaskCore.Task] -> [TaskCore.Task]
+sortTasks SortNewest = List.sortBy (comparing (Down <. TaskCore.taskCreatedAt))
+sortTasks SortOldest = List.sortBy (comparing TaskCore.taskCreatedAt)
+sortTasks SortUpdated = List.sortBy (comparing (Down <. TaskCore.taskUpdatedAt))
+sortTasks SortPriorityHigh = List.sortBy (comparing TaskCore.taskPriority)
+sortTasks SortPriorityLow = List.sortBy (comparing (Down <. TaskCore.taskPriority))
+
parseTimeRange :: Maybe Text -> TimeRange
parseTimeRange (Just "today") = Today
parseTimeRange (Just "week") = Week
@@ -170,22 +206,23 @@ computeMetricsFromActivities tasks activities =
type API =
QueryParam "range" Text :> Get '[Lucid.HTML] HomePage
:<|> "style.css" :> Get '[CSS] LazyText.Text
- :<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage
- :<|> "blocked" :> Get '[Lucid.HTML] BlockedPage
- :<|> "intervention" :> Get '[Lucid.HTML] InterventionPage
+ :<|> "ready" :> QueryParam "sort" Text :> Get '[Lucid.HTML] ReadyQueuePage
+ :<|> "blocked" :> QueryParam "sort" Text :> Get '[Lucid.HTML] BlockedPage
+ :<|> "intervention" :> QueryParam "sort" Text :> Get '[Lucid.HTML] InterventionPage
:<|> "stats" :> QueryParam "epic" Text :> Get '[Lucid.HTML] StatsPage
:<|> "tasks"
:> QueryParam "status" Text
:> QueryParam "priority" Text
:> QueryParam "namespace" Text
:> QueryParam "type" Text
+ :> QueryParam "sort" Text
:> Get '[Lucid.HTML] TaskListPage
:<|> "kb" :> Get '[Lucid.HTML] KBPage
:<|> "kb" :> "create" :> ReqBody '[FormUrlEncoded] FactCreateForm :> PostRedirect
:<|> "kb" :> Capture "id" Int :> Get '[Lucid.HTML] FactDetailPage
:<|> "kb" :> Capture "id" Int :> "edit" :> ReqBody '[FormUrlEncoded] FactEditForm :> PostRedirect
:<|> "kb" :> Capture "id" Int :> "delete" :> PostRedirect
- :<|> "epics" :> Get '[Lucid.HTML] EpicsPage
+ :<|> "epics" :> QueryParam "sort" Text :> Get '[Lucid.HTML] EpicsPage
:<|> "tasks" :> Capture "id" Text :> Get '[Lucid.HTML] TaskDetailPage
:<|> "tasks" :> Capture "id" Text :> "status" :> ReqBody '[FormUrlEncoded] StatusForm :> Post '[Lucid.HTML] StatusBadgePartial
:<|> "tasks" :> Capture "id" Text :> "description" :> "view" :> Get '[Lucid.HTML] DescriptionViewPartial
@@ -206,6 +243,7 @@ type API =
:> QueryParam "priority" Text
:> QueryParam "namespace" Text
:> QueryParam "type" Text
+ :> QueryParam "sort" Text
:> Get '[Lucid.HTML] TaskListPartial
:<|> "partials" :> "task" :> Capture "id" Text :> "metrics" :> Get '[Lucid.HTML] TaskMetricsPartial
@@ -219,13 +257,13 @@ instance MimeRender CSS LazyText.Text where
data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime
-data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] UTCTime
+data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] SortOrder UTCTime
-data BlockedPage = BlockedPage [TaskCore.Task] UTCTime
+data BlockedPage = BlockedPage [TaskCore.Task] SortOrder UTCTime
-data InterventionPage = InterventionPage [TaskCore.Task] UTCTime
+data InterventionPage = InterventionPage [TaskCore.Task] SortOrder UTCTime
-data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters UTCTime
+data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters SortOrder UTCTime
data TaskDetailPage
= TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] (Maybe TaskCore.AggregatedMetrics) UTCTime
@@ -281,7 +319,7 @@ instance FromForm FactCreateForm where
let confidence = fromRight "0.8" (lookupUnique "confidence" form)
Right (FactCreateForm project content files confidence)
-data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task]
+data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] SortOrder
data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int)
@@ -542,6 +580,26 @@ statusBadge status =
TaskCore.Done -> ("badge badge-done", "Done")
in Lucid.span_ [Lucid.class_ cls] label
+sortDropdown :: (Monad m) => Text -> SortOrder -> Lucid.HtmlT m ()
+sortDropdown basePath currentSort =
+ Lucid.div_ [Lucid.class_ "sort-dropdown"] <| do
+ Lucid.span_ [Lucid.class_ "sort-label"] "Sort:"
+ Lucid.div_ [Lucid.class_ "sort-dropdown-wrapper navbar-dropdown"] <| do
+ Lucid.button_ [Lucid.class_ "sort-dropdown-btn navbar-dropdown-btn"]
+ <| Lucid.toHtml (sortOrderLabel currentSort <> " ▾")
+ Lucid.div_ [Lucid.class_ "sort-dropdown-content navbar-dropdown-content"] <| do
+ sortOption basePath SortNewest currentSort
+ sortOption basePath SortOldest currentSort
+ sortOption basePath SortUpdated currentSort
+ sortOption basePath SortPriorityHigh currentSort
+ sortOption basePath SortPriorityLow currentSort
+
+sortOption :: (Monad m) => Text -> SortOrder -> SortOrder -> Lucid.HtmlT m ()
+sortOption basePath option currentSort =
+ let cls = "sort-dropdown-item navbar-dropdown-item" <> if option == currentSort then " active" else ""
+ href = basePath <> "?sort=" <> sortOrderToParam option
+ in Lucid.a_ [Lucid.href_ href, Lucid.class_ cls] (Lucid.toHtml (sortOrderLabel option))
+
multiColorProgressBar :: (Monad m) => TaskCore.TaskStats -> Lucid.HtmlT m ()
multiColorProgressBar stats =
let total = TaskCore.totalTasks stats
@@ -790,26 +848,30 @@ instance Lucid.ToHtml HomePage where
instance Lucid.ToHtml ReadyQueuePage where
toHtmlRaw = Lucid.toHtml
- toHtml (ReadyQueuePage tasks _now) =
+ toHtml (ReadyQueuePage tasks currentSort _now) =
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)")
+ Lucid.div_ [Lucid.class_ "page-header-row"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Ready Queue (" <> tshow (length tasks) <> " tasks)")
+ sortDropdown "/ready" currentSort
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) =
+ toHtml (BlockedPage tasks currentSort _now) =
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.div_ [Lucid.class_ "page-header-row"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Blocked Tasks (" <> tshow (length tasks) <> " tasks)")
+ sortDropdown "/blocked" currentSort
Lucid.p_ [Lucid.class_ "info-msg"] "Tasks with unmet blocking dependencies."
if null tasks
then Lucid.p_ [Lucid.class_ "empty-msg"] "No blocked tasks."
@@ -817,13 +879,15 @@ instance Lucid.ToHtml BlockedPage where
instance Lucid.ToHtml InterventionPage where
toHtmlRaw = Lucid.toHtml
- toHtml (InterventionPage tasks _now) =
+ toHtml (InterventionPage tasks currentSort _now) =
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.div_ [Lucid.class_ "page-header-row"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Needs Intervention (" <> tshow (length tasks) <> " tasks)")
+ sortDropdown "/intervention" currentSort
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."
@@ -1031,13 +1095,15 @@ instance Lucid.ToHtml FactDetailPage where
instance Lucid.ToHtml EpicsPage where
toHtmlRaw = Lucid.toHtml
- toHtml (EpicsPage epics allTasks) =
+ toHtml (EpicsPage epics allTasks currentSort) =
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.div_ [Lucid.class_ "page-header-row"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Epics (" <> tshow (length epics) <> ")")
+ sortDropdown "/epics" currentSort
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."
@@ -1112,13 +1178,15 @@ getDescendants allTasks parentId =
instance Lucid.ToHtml TaskListPage where
toHtmlRaw = Lucid.toHtml
- toHtml (TaskListPage tasks filters _now) =
+ toHtml (TaskListPage tasks filters currentSort _now) =
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_ "page-header-row"] <| do
+ Lucid.h1_ <| Lucid.toHtml ("Tasks (" <> tshow (length tasks) <> ")")
+ sortDropdown "/tasks" currentSort
Lucid.div_ [Lucid.class_ "filter-form"] <| do
Lucid.form_
@@ -2150,26 +2218,29 @@ server =
hasMoreRecent = length filteredTasks > 5
pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now)
- readyQueueHandler :: Servant.Handler ReadyQueuePage
- readyQueueHandler = do
+ readyQueueHandler :: Maybe Text -> Servant.Handler ReadyQueuePage
+ readyQueueHandler maybeSortText = do
now <- liftIO getCurrentTime
readyTasks <- liftIO TaskCore.getReadyTasks
- let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) readyTasks
- pure (ReadyQueuePage sortedTasks now)
+ let sortOrder = parseSortOrder maybeSortText
+ sortedTasks = sortTasks sortOrder readyTasks
+ pure (ReadyQueuePage sortedTasks sortOrder now)
- blockedHandler :: Servant.Handler BlockedPage
- blockedHandler = do
+ blockedHandler :: Maybe Text -> Servant.Handler BlockedPage
+ blockedHandler maybeSortText = do
now <- liftIO getCurrentTime
blockedTasks <- liftIO TaskCore.getBlockedTasks
- let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) blockedTasks
- pure (BlockedPage sortedTasks now)
+ let sortOrder = parseSortOrder maybeSortText
+ sortedTasks = sortTasks sortOrder blockedTasks
+ pure (BlockedPage sortedTasks sortOrder now)
- interventionHandler :: Servant.Handler InterventionPage
- interventionHandler = do
+ interventionHandler :: Maybe Text -> Servant.Handler InterventionPage
+ interventionHandler maybeSortText = do
now <- liftIO getCurrentTime
interventionTasks <- liftIO TaskCore.getInterventionTasks
- let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) interventionTasks
- pure (InterventionPage sortedTasks now)
+ let sortOrder = parseSortOrder maybeSortText
+ sortedTasks = sortTasks sortOrder interventionTasks
+ pure (InterventionPage sortedTasks sortOrder now)
statsHandler :: Maybe Text -> Servant.Handler StatsPage
statsHandler maybeEpic = do
@@ -2177,16 +2248,17 @@ server =
stats <- liftIO <| TaskCore.getTaskStats epicId
pure (StatsPage stats epicId)
- taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
- taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
+ taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage
+ taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
now <- liftIO getCurrentTime
allTasks <- liftIO TaskCore.loadTasks
let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
maybePriority = parsePriority =<< emptyToNothing maybePriorityText
maybeType = parseTaskType =<< emptyToNothing maybeTypeText
filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
- filteredTasks = applyFilters filters allTasks
- pure (TaskListPage filteredTasks filters now)
+ sortOrder = parseSortOrder maybeSortText
+ filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
+ pure (TaskListPage filteredTasks filters sortOrder now)
kbHandler :: Servant.Handler KBPage
kbHandler = do
@@ -2220,12 +2292,13 @@ server =
liftIO (Fact.deleteFact fid)
pure <| addHeader "/kb" NoContent
- epicsHandler :: Servant.Handler EpicsPage
- epicsHandler = do
+ epicsHandler :: Maybe Text -> Servant.Handler EpicsPage
+ epicsHandler maybeSortText = do
allTasks <- liftIO TaskCore.loadTasks
let epicTasks = filter (\t -> TaskCore.taskType t == TaskCore.Epic) allTasks
- sortedEpics = List.sortBy (compare `on` TaskCore.taskPriority) epicTasks
- pure (EpicsPage sortedEpics allTasks)
+ sortOrder = parseSortOrder maybeSortText
+ sortedEpics = sortTasks sortOrder epicTasks
+ pure (EpicsPage sortedEpics allTasks sortOrder)
parseStatus :: Text -> Maybe TaskCore.Status
parseStatus = readMaybe <. Text.unpack
@@ -2394,14 +2467,15 @@ server =
readyTasks <- liftIO TaskCore.getReadyTasks
pure (ReadyCountPartial (length readyTasks))
- taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
- taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = do
+ taskListPartialHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPartial
+ taskListPartialHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText maybeSortText = do
allTasks <- liftIO TaskCore.loadTasks
let maybeStatus = parseStatus =<< emptyToNothing maybeStatusText
maybePriority = parsePriority =<< emptyToNothing maybePriorityText
maybeType = parseTaskType =<< emptyToNothing maybeTypeText
filters = TaskFilters maybeStatus maybePriority (emptyToNothing maybeNamespace) maybeType
- filteredTasks = applyFilters filters allTasks
+ sortOrder = parseSortOrder maybeSortText
+ filteredTasks = sortTasks sortOrder (applyFilters filters allTasks)
pure (TaskListPartial filteredTasks)
taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial
diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs
index e0cc51e..02352ec 100644
--- a/Omni/Jr/Web/Style.hs
+++ b/Omni/Jr/Web/Style.hs
@@ -37,6 +37,7 @@ stylesheet = do
retryBannerStyles
taskMetaStyles
timeFilterStyles
+ sortDropdownStyles
responsiveStyles
darkModeStyles
@@ -1217,6 +1218,52 @@ timeFilterStyles = do
backgroundColor "#0055aa"
borderColor "#0055aa"
+sortDropdownStyles :: Css
+sortDropdownStyles = do
+ ".page-header-row" ? do
+ display flex
+ alignItems center
+ justifyContent spaceBetween
+ flexWrap Flexbox.wrap
+ Stylesheet.key "gap" ("12px" :: Text)
+ marginBottom (px 8)
+ ".page-header-row" |> "h1" ? do
+ margin (px 0) (px 0) (px 0) (px 0)
+ ".sort-dropdown" ? do
+ display flex
+ alignItems center
+ Stylesheet.key "gap" ("6px" :: Text)
+ fontSize (px 13)
+ ".sort-label" ? do
+ color "#6b7280"
+ fontWeight (weight 500)
+ ".sort-dropdown-wrapper" ? do
+ position relative
+ ".sort-dropdown-btn" ? do
+ padding (px 4) (px 10) (px 4) (px 10)
+ fontSize (px 13)
+ fontWeight (weight 500)
+ border (px 1) solid "#d0d0d0"
+ borderRadius (px 4) (px 4) (px 4) (px 4)
+ backgroundColor white
+ color "#374151"
+ cursor pointer
+ transition "all" (ms 150) ease (sec 0)
+ whiteSpace nowrap
+ ".sort-dropdown-btn" # hover ? do
+ borderColor "#999"
+ backgroundColor "#f3f4f6"
+ ".sort-dropdown-content" ? do
+ minWidth (px 160)
+ right (px 0)
+ left auto
+ ".sort-dropdown-item" ? do
+ padding (px 8) (px 12) (px 8) (px 12)
+ fontSize (px 13)
+ ".sort-dropdown-item.active" ? do
+ backgroundColor "#e0f2fe"
+ fontWeight (weight 600)
+
taskMetaStyles :: Css
taskMetaStyles = do
".task-meta" ? do
@@ -1489,6 +1536,16 @@ darkModeStyles =
".time-filter-btn.active" # hover ? do
backgroundColor "#2563eb"
borderColor "#2563eb"
+ ".sort-label" ? color "#9ca3af"
+ ".sort-dropdown-btn" ? do
+ backgroundColor "#374151"
+ borderColor "#4b5563"
+ color "#d1d5db"
+ ".sort-dropdown-btn" # hover ? do
+ backgroundColor "#4b5563"
+ borderColor "#6b7280"
+ ".sort-dropdown-item.active" ? do
+ backgroundColor "#1e3a5f"
-- Responsive dark mode: dropdown content needs background on mobile
query Media.screen [Media.maxWidth (px 600)] <| do
".navbar-dropdown-content" ? do
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 18:56:43 +0000