From a5180facf2375cf629ce7d90f851e6c667f66197 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 29 Nov 2025 22:09:56 -0500 Subject: Add time range filter to homepage Task Status section The build and tests pass with no errors. The time range filter feature f **Implementation summary:** - Route accepts `?range=today|week|month|all` query param - `TimeRange` type with `Today`, `Week`, `Month`, `AllTime` variants - `homeHandler` filters both tasks and activities by time range - Toggle buttons rendered with `timeFilterBtn` helper - Full CSS styling in `timeFilterStyles` with dark mode support - Default selection: "All Time" Task-Id: t-180 --- Omni/Jr/Web.hs | 126 ++++++++++++++++++++++++++++++++++++++++++++++----- Omni/Jr/Web/Style.hs | 46 +++++++++++++++++++ Omni/Task/Core.hs | 37 +++++++++++++++ 3 files changed, 197 insertions(+), 12 deletions(-) diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 533d761..3380b93 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -21,7 +21,8 @@ import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText -import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime) +import Data.Time (Day, NominalDiffTime, UTCTime (..), dayOfWeek, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime, toGregorian) +import Data.Time.Calendar (DayOfWeek (..)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import qualified Lucid import qualified Lucid.Base as Lucid @@ -89,8 +90,85 @@ data TaskFilters = TaskFilters } deriving (Show, Eq) +data TimeRange = Today | Week | Month | AllTime + deriving (Show, Eq) + +parseTimeRange :: Maybe Text -> TimeRange +parseTimeRange (Just "today") = Today +parseTimeRange (Just "week") = Week +parseTimeRange (Just "month") = Month +parseTimeRange _ = AllTime + +timeRangeToParam :: TimeRange -> Text +timeRangeToParam Today = "today" +timeRangeToParam Week = "week" +timeRangeToParam Month = "month" +timeRangeToParam AllTime = "all" + +getTimeRangeStart :: TimeRange -> UTCTime -> Maybe UTCTime +getTimeRangeStart AllTime _ = Nothing +getTimeRangeStart Today now = Just (startOfDay now) +getTimeRangeStart Week now = Just (startOfWeek now) +getTimeRangeStart Month now = Just (startOfMonth now) + +startOfDay :: UTCTime -> UTCTime +startOfDay t = UTCTime (utctDay t) 0 + +startOfWeek :: UTCTime -> UTCTime +startOfWeek t = + let day = utctDay t + dow = dayOfWeek day + daysBack = case dow of + Monday -> 0 + Tuesday -> 1 + Wednesday -> 2 + Thursday -> 3 + Friday -> 4 + Saturday -> 5 + Sunday -> 6 + in UTCTime (addDays (negate daysBack) day) 0 + +addDays :: Integer -> Day -> Day +addDays n d = + let (y, m, dayNum) = toGregorian d + in fromGregorian y m (dayNum + fromInteger n) + +fromGregorian :: Integer -> Int -> Int -> Day +fromGregorian y m d = toEnum (fromInteger (daysSinceEpoch y m d)) + +daysSinceEpoch :: Integer -> Int -> Int -> Integer +daysSinceEpoch y m d = + let a = (14 - m) `div` 12 + y' = y + 4800 - toInteger a + m' = m + 12 * a - 3 + jdn = d + (153 * m' + 2) `div` 5 + 365 * fromInteger y' + fromInteger y' `div` 4 - fromInteger y' `div` 100 + fromInteger y' `div` 400 - 32045 + in toInteger jdn - 2440588 + +startOfMonth :: UTCTime -> UTCTime +startOfMonth t = + let day = utctDay t + (y, m, _) = toGregorian day + in UTCTime (fromGregorian y m 1) 0 + +computeMetricsFromActivities :: [TaskCore.Task] -> [TaskCore.TaskActivity] -> TaskCore.AggregatedMetrics +computeMetricsFromActivities tasks activities = + let completedCount = length [t | t <- tasks, TaskCore.taskStatus t == TaskCore.Done] + totalCost = sum [c | act <- activities, Just c <- [TaskCore.activityCostCents act]] + totalTokens = sum [t | act <- activities, Just t <- [TaskCore.activityTokensUsed act]] + totalDuration = sum [calcDuration act | act <- activities] + in TaskCore.AggregatedMetrics + { TaskCore.aggTotalCostCents = totalCost, + TaskCore.aggTotalDurationSeconds = totalDuration, + TaskCore.aggCompletedTasks = completedCount, + TaskCore.aggTotalTokens = totalTokens + } + where + calcDuration act = case (TaskCore.activityStartedAt act, TaskCore.activityCompletedAt act) of + (Just start, Just end) -> floor (diffUTCTime end start) + _ -> 0 + type API = - Get '[Lucid.HTML] HomePage + QueryParam "range" Text :> Get '[Lucid.HTML] HomePage :<|> "style.css" :> Get '[CSS] LazyText.Text :<|> "ready" :> Get '[Lucid.HTML] ReadyQueuePage :<|> "blocked" :> Get '[Lucid.HTML] BlockedPage @@ -139,7 +217,7 @@ instance Accept CSS where instance MimeRender CSS LazyText.Text where mimeRender _ = LazyText.encodeUtf8 -data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics UTCTime +data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool TaskCore.AggregatedMetrics TimeRange UTCTime data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] UTCTime @@ -611,12 +689,17 @@ renderListGroupItem t = instance Lucid.ToHtml HomePage where toHtmlRaw = Lucid.toHtml - toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics _now) = + toHtml (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics currentRange _now) = Lucid.doctypehtml_ <| do pageHead "Jr Dashboard" pageBody <| do Lucid.div_ [Lucid.class_ "container"] <| do Lucid.h2_ "Task Status" + Lucid.div_ [Lucid.class_ "time-filter"] <| do + timeFilterBtn "Today" Today currentRange + timeFilterBtn "This Week" Week currentRange + timeFilterBtn "This Month" Month currentRange + timeFilterBtn "All Time" AllTime currentRange Lucid.div_ [Lucid.class_ "stats-grid"] <| do statCard "Open" (TaskCore.openTasks stats) "badge-open" "/tasks?status=Open" statCard "In Progress" (TaskCore.inProgressTasks stats) "badge-inprogress" "/tasks?status=InProgress" @@ -695,6 +778,16 @@ instance Lucid.ToHtml HomePage where mins = (totalSeconds `mod` 3600) `div` 60 in tshow hours <> "h " <> tshow mins <> "m" + timeFilterBtn :: (Monad m) => Text -> TimeRange -> TimeRange -> Lucid.HtmlT m () + timeFilterBtn label range current = + let activeClass = if range == current then " active" else "" + href = "/?" <> "range=" <> timeRangeToParam range + in Lucid.a_ + [ Lucid.href_ href, + Lucid.class_ ("time-filter-btn" <> activeClass) + ] + (Lucid.toHtml label) + instance Lucid.ToHtml ReadyQueuePage where toHtmlRaw = Lucid.toHtml toHtml (ReadyQueuePage tasks _now) = @@ -2036,17 +2129,26 @@ server = styleHandler :: Servant.Handler LazyText.Text styleHandler = pure Style.css - homeHandler :: Servant.Handler HomePage - homeHandler = do + homeHandler :: Maybe Text -> Servant.Handler HomePage + homeHandler maybeRangeText = do now <- liftIO getCurrentTime - stats <- liftIO <| TaskCore.getTaskStats Nothing - readyTasks <- liftIO TaskCore.getReadyTasks + let range = parseTimeRange maybeRangeText + maybeStart = getTimeRangeStart range now allTasks <- liftIO TaskCore.loadTasks - globalMetrics <- liftIO TaskCore.getGlobalAggregatedMetrics - let sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks + let filteredTasks = case maybeStart of + Nothing -> allTasks + Just start -> [t | t <- allTasks, TaskCore.taskUpdatedAt t >= start] + stats = TaskCore.computeTaskStatsFromList filteredTasks + readyTasks <- liftIO TaskCore.getReadyTasks + allActivities <- liftIO <| concat allActivities + Just start -> [a | a <- allActivities, TaskCore.activityTimestamp a >= start] + globalMetrics = computeMetricsFromActivities filteredTasks filteredActivities + sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) filteredTasks recentTasks = take 5 sortedTasks - hasMoreRecent = length allTasks > 5 - pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics now) + hasMoreRecent = length filteredTasks > 5 + pure (HomePage stats readyTasks recentTasks hasMoreRecent globalMetrics range now) readyQueueHandler :: Servant.Handler ReadyQueuePage readyQueueHandler = do diff --git a/Omni/Jr/Web/Style.hs b/Omni/Jr/Web/Style.hs index ad1ff02..e0cc51e 100644 --- a/Omni/Jr/Web/Style.hs +++ b/Omni/Jr/Web/Style.hs @@ -36,6 +36,7 @@ stylesheet = do markdownStyles retryBannerStyles taskMetaStyles + timeFilterStyles responsiveStyles darkModeStyles @@ -1185,6 +1186,37 @@ retryBannerStyles = do color "#991b1b" fontWeight (weight 500) +timeFilterStyles :: Css +timeFilterStyles = do + ".time-filter" ? do + display flex + Stylesheet.key "gap" ("6px" :: Text) + marginBottom (px 12) + flexWrap Flexbox.wrap + ".time-filter-btn" ? do + display inlineBlock + padding (px 4) (px 12) (px 4) (px 12) + fontSize (px 12) + fontWeight (weight 500) + textDecoration none + borderRadius (px 12) (px 12) (px 12) (px 12) + border (px 1) solid "#d0d0d0" + backgroundColor white + color "#374151" + transition "all" (ms 150) ease (sec 0) + cursor pointer + ".time-filter-btn" # hover ? do + borderColor "#999" + backgroundColor "#f3f4f6" + textDecoration none + ".time-filter-btn.active" ? do + backgroundColor "#0066cc" + borderColor "#0066cc" + color white + ".time-filter-btn.active" # hover ? do + backgroundColor "#0055aa" + borderColor "#0055aa" + taskMetaStyles :: Css taskMetaStyles = do ".task-meta" ? do @@ -1443,6 +1475,20 @@ darkModeStyles = ".fact-create-form" ? do backgroundColor "#1f2937" borderColor "#374151" + ".time-filter-btn" ? do + backgroundColor "#374151" + borderColor "#4b5563" + color "#d1d5db" + ".time-filter-btn" # hover ? do + backgroundColor "#4b5563" + borderColor "#6b7280" + ".time-filter-btn.active" ? do + backgroundColor "#3b82f6" + borderColor "#3b82f6" + color white + ".time-filter-btn.active" # hover ? do + backgroundColor "#2563eb" + borderColor "#2563eb" -- Responsive dark mode: dropdown content needs background on mobile query Media.screen [Media.maxWidth (px 600)] <| do ".navbar-dropdown-content" ? do diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index 722e696..d64d607 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -1133,6 +1133,43 @@ getAllDescendants allTasks parentId = let children = filter (maybe False (`matchesId` parentId) <. taskParent) allTasks in children ++ concatMap (getAllDescendants allTasks <. taskId) children +computeTaskStatsFromList :: [Task] -> TaskStats +computeTaskStatsFromList tasks = + let total = length tasks + draft = length [t | t <- tasks, taskStatus t == Draft] + open = length [t | t <- tasks, taskStatus t == Open] + inProg = length [t | t <- tasks, taskStatus t == InProgress] + review = length [t | t <- tasks, taskStatus t == Review] + approved = length [t | t <- tasks, taskStatus t == Approved] + done = length [t | t <- tasks, taskStatus t == Done] + epics = length [t | t <- tasks, taskType t == Epic] + readyCount = open + inProg + blockedCount = 0 + byPriority = + [ (P0, length [t | t <- tasks, taskPriority t == P0]), + (P1, length [t | t <- tasks, taskPriority t == P1]), + (P2, length [t | t <- tasks, taskPriority t == P2]), + (P3, length [t | t <- tasks, taskPriority t == P3]), + (P4, length [t | t <- tasks, taskPriority t == P4]) + ] + namespaces = mapMaybe taskNamespace tasks + uniqueNs = List.nub namespaces + byNamespace = [(ns, length [t | t <- tasks, taskNamespace t == Just ns]) | ns <- uniqueNs] + in TaskStats + { totalTasks = total, + draftTasks = draft, + openTasks = open, + inProgressTasks = inProg, + reviewTasks = review, + approvedTasks = approved, + doneTasks = done, + totalEpics = epics, + readyTasks = readyCount, + blockedTasks = blockedCount, + tasksByPriority = byPriority, + tasksByNamespace = byNamespace + } + showTaskStats :: Maybe Text -> IO () showTaskStats maybeEpicId = do stats <- getTaskStats maybeEpicId -- cgit v1.2.3