Remove Jr Dashboard header from homepage

The build and tests pass. The "Jr Dashboard" header has been removed
fro

Task-Id: t-154.6

1 files changed, 75 insertions, 47 deletions

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