From a4754527ea4244e7933be86471324d9ae65a87e2 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 28 Nov 2025 02:33:03 -0500 Subject: Remove Jr Dashboard header from homepage The build and tests pass. The "Jr Dashboard" header has been removed fro Task-Id: t-154.6 --- Omni/Jr/Web.hs | 122 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 75 insertions(+), 47 deletions(-) (limited to 'Omni/Jr') diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 465c021..505baca 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -21,7 +21,7 @@ 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 (UTCTime, defaultTimeLocale, diffUTCTime, formatTime) +import Data.Time (NominalDiffTime, UTCTime, defaultTimeLocale, diffUTCTime, formatTime, getCurrentTime) import qualified Lucid import qualified Lucid.Base as Lucid import qualified Network.Wai.Handler.Warp as Warp @@ -40,6 +40,36 @@ type PostRedirect = Verb 'POST 303 '[Lucid.HTML] (Headers '[Header "Location" Te defaultPort :: Warp.Port defaultPort = 8080 +formatRelativeTime :: UTCTime -> UTCTime -> Text +formatRelativeTime now timestamp = + let delta = diffUTCTime now timestamp + in relativeText delta + +relativeText :: NominalDiffTime -> Text +relativeText delta + | delta < 60 = "just now" + | delta < 3600 = tshow (round (delta / 60) :: Int) <> " minutes ago" + | delta < 7200 = "1 hour ago" + | delta < 86400 = tshow (round (delta / 3600) :: Int) <> " hours ago" + | delta < 172800 = "yesterday" + | delta < 604800 = tshow (round (delta / 86400) :: Int) <> " days ago" + | delta < 1209600 = "1 week ago" + | delta < 2592000 = tshow (round (delta / 604800) :: Int) <> " weeks ago" + | delta < 5184000 = "1 month ago" + | delta < 31536000 = tshow (round (delta / 2592000) :: Int) <> " months ago" + | otherwise = tshow (round (delta / 31536000) :: Int) <> " years ago" + +formatExactTimestamp :: UTCTime -> Text +formatExactTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S UTC" + +renderRelativeTimestamp :: (Monad m) => UTCTime -> UTCTime -> Lucid.HtmlT m () +renderRelativeTimestamp now timestamp = + Lucid.span_ + [ Lucid.class_ "relative-time", + Lucid.title_ (formatExactTimestamp timestamp) + ] + (Lucid.toHtml (formatRelativeTime now timestamp)) + data TaskFilters = TaskFilters { filterStatus :: Maybe TaskCore.Status, filterPriority :: Maybe TaskCore.Priority, @@ -95,18 +125,18 @@ instance Accept CSS where instance MimeRender CSS LazyText.Text where mimeRender _ = LazyText.encodeUtf8 -data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool +data HomePage = HomePage TaskCore.TaskStats [TaskCore.Task] [TaskCore.Task] Bool UTCTime -newtype ReadyQueuePage = ReadyQueuePage [TaskCore.Task] +data ReadyQueuePage = ReadyQueuePage [TaskCore.Task] UTCTime -newtype BlockedPage = BlockedPage [TaskCore.Task] +data BlockedPage = BlockedPage [TaskCore.Task] UTCTime -newtype InterventionPage = InterventionPage [TaskCore.Task] +data InterventionPage = InterventionPage [TaskCore.Task] UTCTime -data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters +data TaskListPage = TaskListPage [TaskCore.Task] TaskFilters UTCTime data TaskDetailPage - = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] + = TaskDetailFound TaskCore.Task [TaskCore.Task] [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) [GitCommit] UTCTime | TaskDetailNotFound Text data GitCommit = GitCommit @@ -137,7 +167,7 @@ data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) newtype KBPage = KBPage [TaskCore.Fact] data FactDetailPage - = FactDetailFound TaskCore.Fact + = FactDetailFound TaskCore.Fact UTCTime | FactDetailNotFound Int data FactEditForm = FactEditForm Text Text Text @@ -161,7 +191,7 @@ instance FromForm FactCreateForm where data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] -data RecentActivityPartial = RecentActivityPartial [TaskCore.Task] Int Bool +data RecentActivityPartial = RecentActivityPartial [TaskCore.Task] Int Bool UTCTime newtype ReadyCountPartial = ReadyCountPartial Int @@ -169,7 +199,7 @@ data StatusBadgePartial = StatusBadgePartial TaskCore.Status Text newtype TaskListPartial = TaskListPartial [TaskCore.Task] -data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) +data TaskMetricsPartial = TaskMetricsPartial Text [TaskCore.TaskActivity] (Maybe TaskCore.RetryContext) UTCTime newtype RejectForm = RejectForm (Maybe Text) @@ -479,14 +509,12 @@ renderListGroupItem t = instance Lucid.ToHtml HomePage where toHtmlRaw = Lucid.toHtml - toHtml (HomePage stats readyTasks recentTasks hasMoreRecent) = + toHtml (HomePage stats readyTasks recentTasks hasMoreRecent _now) = Lucid.doctypehtml_ <| do pageHead "Jr Dashboard" Lucid.body_ <| do navbar Lucid.div_ [Lucid.class_ "container"] <| do - Lucid.h1_ "Jr Dashboard" - Lucid.h2_ "Task Status" multiColorProgressBar stats Lucid.div_ [Lucid.class_ "stats-grid"] <| do @@ -541,7 +569,7 @@ instance Lucid.ToHtml HomePage where instance Lucid.ToHtml ReadyQueuePage where toHtmlRaw = Lucid.toHtml - toHtml (ReadyQueuePage tasks) = + toHtml (ReadyQueuePage tasks _now) = Lucid.doctypehtml_ <| do pageHead "Ready Queue - Jr" Lucid.body_ <| do @@ -554,7 +582,7 @@ instance Lucid.ToHtml ReadyQueuePage where instance Lucid.ToHtml BlockedPage where toHtmlRaw = Lucid.toHtml - toHtml (BlockedPage tasks) = + toHtml (BlockedPage tasks _now) = Lucid.doctypehtml_ <| do pageHead "Blocked Tasks - Jr" Lucid.body_ <| do @@ -568,7 +596,7 @@ instance Lucid.ToHtml BlockedPage where instance Lucid.ToHtml InterventionPage where toHtmlRaw = Lucid.toHtml - toHtml (InterventionPage tasks) = + toHtml (InterventionPage tasks _now) = Lucid.doctypehtml_ <| do pageHead "Needs Intervention - Jr" Lucid.body_ <| do @@ -688,7 +716,7 @@ instance Lucid.ToHtml FactDetailPage where Lucid.h1_ "Fact Not Found" Lucid.p_ [Lucid.class_ "error-msg"] (Lucid.toHtml ("Fact with ID " <> tshow fid <> " not found.")) Lucid.a_ [Lucid.href_ "/kb", Lucid.class_ "btn btn-secondary"] "Back to Knowledge Base" - toHtml (FactDetailFound fact) = + toHtml (FactDetailFound fact now) = Lucid.doctypehtml_ <| do pageHead "Fact Detail - Jr" Lucid.body_ <| do @@ -703,7 +731,7 @@ instance Lucid.ToHtml FactDetailPage where Lucid.span_ [Lucid.class_ "meta-label"] "Confidence:" confidenceBadgeDetail (TaskCore.factConfidence fact) Lucid.span_ [Lucid.class_ "meta-label"] "Created:" - Lucid.span_ [Lucid.class_ "meta-value"] (Lucid.toHtml (formatTimestamp (TaskCore.factCreatedAt fact))) + Lucid.span_ [Lucid.class_ "meta-value"] (renderRelativeTimestamp now (TaskCore.factCreatedAt fact)) Lucid.div_ [Lucid.class_ "detail-section"] <| do Lucid.h2_ "Content" @@ -770,9 +798,6 @@ instance Lucid.ToHtml FactDetailPage where Lucid.div_ [Lucid.class_ "back-link"] <| do Lucid.a_ [Lucid.href_ "/kb"] "← Back to Knowledge Base" where - formatTimestamp :: UTCTime -> Text - formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" - confidenceBadgeDetail :: (Monad m) => Double -> Lucid.HtmlT m () confidenceBadgeDetail conf = let pct = floor (conf * 100) :: Int @@ -837,7 +862,7 @@ getDescendants allTasks parentId = instance Lucid.ToHtml TaskListPage where toHtmlRaw = Lucid.toHtml - toHtml (TaskListPage tasks filters) = + toHtml (TaskListPage tasks filters _now) = Lucid.doctypehtml_ <| do pageHead "Tasks - Jr" Lucid.body_ <| do @@ -928,7 +953,7 @@ instance Lucid.ToHtml TaskDetailPage where "The task " Lucid.code_ (Lucid.toHtml tid) " could not be found." - toHtml (TaskDetailFound task allTasks activities maybeRetry commits) = + toHtml (TaskDetailFound task allTasks activities maybeRetry commits now) = Lucid.doctypehtml_ <| do pageHead (TaskCore.taskId task <> " - Jr") Lucid.body_ <| do @@ -973,11 +998,11 @@ instance Lucid.ToHtml TaskDetailPage where 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.span_ [Lucid.class_ "detail-value"] (renderRelativeTimestamp now (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))) + Lucid.span_ [Lucid.class_ "detail-value"] (renderRelativeTimestamp now (TaskCore.taskUpdatedAt task)) let deps = TaskCore.taskDependencies task unless (null deps) <| do @@ -1098,7 +1123,7 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.div_ [Lucid.class_ "activity-content"] <| do Lucid.div_ [Lucid.class_ "activity-header"] <| do Lucid.span_ [Lucid.class_ "activity-stage"] (Lucid.toHtml (tshow (TaskCore.activityStage act))) - Lucid.span_ [Lucid.class_ "activity-time"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act))) + Lucid.span_ [Lucid.class_ "activity-time"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act)) case TaskCore.activityMessage act of Nothing -> pure () Just msg -> Lucid.p_ [Lucid.class_ "activity-message"] (Lucid.toHtml msg) @@ -1127,9 +1152,6 @@ instance Lucid.ToHtml TaskDetailPage where TaskCore.Completed -> "✓" TaskCore.Failed -> "✗" - formatTimestamp :: UTCTime -> Text - formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" - renderExecutionDetails :: (Monad m) => Text -> [TaskCore.TaskActivity] -> Maybe TaskCore.RetryContext -> Lucid.HtmlT m () renderExecutionDetails _ acts retryCtx = case findRunningAct acts of @@ -1151,7 +1173,7 @@ instance Lucid.ToHtml TaskDetailPage where (Just start, Nothing) -> Lucid.div_ [Lucid.class_ "metric-row"] <| do Lucid.span_ [Lucid.class_ "metric-label"] "Started:" - Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp start)) + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now start) _ -> pure () case TaskCore.activityCostCents act of @@ -1170,7 +1192,7 @@ instance Lucid.ToHtml TaskDetailPage where Lucid.div_ [Lucid.class_ "metric-row"] <| do Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:" - Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act))) + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act)) where findRunningAct = List.find (\a -> TaskCore.activityStage a == TaskCore.Running) @@ -1470,7 +1492,7 @@ instance Lucid.ToHtml StatsPage where instance Lucid.ToHtml RecentActivityPartial where toHtmlRaw = Lucid.toHtml - toHtml (RecentActivityPartial recentTasks nextOffset hasMore) = + toHtml (RecentActivityPartial recentTasks nextOffset hasMore _now) = if null recentTasks then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." else do @@ -1505,7 +1527,7 @@ instance Lucid.ToHtml TaskListPartial where instance Lucid.ToHtml TaskMetricsPartial where toHtmlRaw = Lucid.toHtml - toHtml (TaskMetricsPartial _tid activities maybeRetry) = + toHtml (TaskMetricsPartial _tid activities maybeRetry now) = Lucid.div_ [Lucid.class_ "execution-details"] <| do case findRunningActivity activities of Nothing -> Lucid.p_ [Lucid.class_ "empty-msg"] "No worker execution data available." @@ -1525,7 +1547,7 @@ instance Lucid.ToHtml TaskMetricsPartial where (Just start, Nothing) -> Lucid.div_ [Lucid.class_ "metric-row"] <| do Lucid.span_ [Lucid.class_ "metric-label"] "Started:" - Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp start)) + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now start) _ -> pure () case TaskCore.activityCostCents act of @@ -1551,13 +1573,10 @@ instance Lucid.ToHtml TaskMetricsPartial where Lucid.div_ [Lucid.class_ "metric-row"] <| do Lucid.span_ [Lucid.class_ "metric-label"] "Last Activity:" - Lucid.span_ [Lucid.class_ "metric-value"] (Lucid.toHtml (formatTimestamp (TaskCore.activityTimestamp act))) + Lucid.span_ [Lucid.class_ "metric-value"] (renderRelativeTimestamp now (TaskCore.activityTimestamp act)) where findRunningActivity = List.find (\a -> TaskCore.activityStage a == TaskCore.Running) - formatTimestamp :: UTCTime -> Text - formatTimestamp = Text.pack <. formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" - formatDuration :: UTCTime -> UTCTime -> Text formatDuration start end = let diffSecs = floor (diffUTCTime end start) :: Int @@ -1720,31 +1739,35 @@ server = homeHandler :: Servant.Handler HomePage homeHandler = do + now <- liftIO getCurrentTime stats <- liftIO <| TaskCore.getTaskStats Nothing readyTasks <- liftIO TaskCore.getReadyTasks allTasks <- liftIO TaskCore.loadTasks let sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks recentTasks = take 5 sortedTasks hasMoreRecent = length allTasks > 5 - pure (HomePage stats readyTasks recentTasks hasMoreRecent) + pure (HomePage stats readyTasks recentTasks hasMoreRecent now) readyQueueHandler :: Servant.Handler ReadyQueuePage readyQueueHandler = do + now <- liftIO getCurrentTime readyTasks <- liftIO TaskCore.getReadyTasks let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) readyTasks - pure (ReadyQueuePage sortedTasks) + pure (ReadyQueuePage sortedTasks now) blockedHandler :: Servant.Handler BlockedPage blockedHandler = do + now <- liftIO getCurrentTime blockedTasks <- liftIO TaskCore.getBlockedTasks let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) blockedTasks - pure (BlockedPage sortedTasks) + pure (BlockedPage sortedTasks now) interventionHandler :: Servant.Handler InterventionPage interventionHandler = do + now <- liftIO getCurrentTime interventionTasks <- liftIO TaskCore.getInterventionTasks let sortedTasks = List.sortBy (compare `on` TaskCore.taskPriority) interventionTasks - pure (InterventionPage sortedTasks) + pure (InterventionPage sortedTasks now) statsHandler :: Maybe Text -> Servant.Handler StatsPage statsHandler maybeEpic = do @@ -1754,13 +1777,14 @@ server = taskListHandler :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Servant.Handler TaskListPage taskListHandler maybeStatusText maybePriorityText maybeNamespace maybeTypeText = 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) + pure (TaskListPage filteredTasks filters now) kbHandler :: Servant.Handler KBPage kbHandler = do @@ -1776,10 +1800,11 @@ server = factDetailHandler :: Int -> Servant.Handler FactDetailPage factDetailHandler fid = do + now <- liftIO getCurrentTime maybeFact <- liftIO (Fact.getFact fid) case maybeFact of Nothing -> pure (FactDetailNotFound fid) - Just fact -> pure (FactDetailFound fact) + Just fact -> pure (FactDetailFound fact now) factEditHandler :: Int -> FactEditForm -> Servant.Handler (Headers '[Header "Location" Text] NoContent) factEditHandler fid (FactEditForm content filesText confText) = do @@ -1842,6 +1867,7 @@ server = taskDetailHandler :: Text -> Servant.Handler TaskDetailPage taskDetailHandler tid = do + now <- liftIO getCurrentTime tasks <- liftIO TaskCore.loadTasks case TaskCore.findTask tid tasks of Nothing -> pure (TaskDetailNotFound tid) @@ -1849,7 +1875,7 @@ server = activities <- liftIO (TaskCore.getActivitiesForTask tid) retryCtx <- liftIO (TaskCore.getRetryContext tid) commits <- liftIO (getCommitsForTask tid) - pure (TaskDetailFound task tasks activities retryCtx commits) + pure (TaskDetailFound task tasks activities retryCtx commits now) taskStatusHandler :: Text -> StatusForm -> Servant.Handler StatusBadgePartial taskStatusHandler tid (StatusForm newStatus) = do @@ -1919,6 +1945,7 @@ server = recentActivityHandler :: Maybe Int -> Servant.Handler RecentActivityPartial recentActivityHandler maybeOffset = do + now <- liftIO getCurrentTime allTasks <- liftIO TaskCore.loadTasks let offset = fromMaybe 0 maybeOffset pageSize = 5 @@ -1926,7 +1953,7 @@ server = pageTasks = take pageSize <| drop offset sortedTasks hasMore = length sortedTasks > offset + pageSize nextOffset = offset + pageSize - pure (RecentActivityPartial pageTasks nextOffset hasMore) + pure (RecentActivityPartial pageTasks nextOffset hasMore now) readyCountHandler :: Servant.Handler ReadyCountPartial readyCountHandler = do @@ -1945,9 +1972,10 @@ server = taskMetricsPartialHandler :: Text -> Servant.Handler TaskMetricsPartial taskMetricsPartialHandler tid = do + now <- liftIO getCurrentTime activities <- liftIO (TaskCore.getActivitiesForTask tid) maybeRetry <- liftIO (TaskCore.getRetryContext tid) - pure (TaskMetricsPartial tid activities maybeRetry) + pure (TaskMetricsPartial tid activities maybeRetry now) getReviewInfo :: Text -> IO ReviewInfo getReviewInfo tid = do -- cgit v1.2.3