diff options
| -rw-r--r-- | Omni/Jr/Web.hs | 98 |
1 files changed, 66 insertions, 32 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 607d9d9..f65f001 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -22,6 +22,7 @@ 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.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import qualified Lucid import qualified Lucid.Base as Lucid import qualified Network.Wai.Handler.Warp as Warp @@ -106,7 +107,8 @@ type API = :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect :<|> "tasks" :> Capture "id" Text :> "reset-retries" :> PostRedirect - :<|> "partials" :> "recent-activity" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityPartial + :<|> "partials" :> "recent-activity-new" :> QueryParam "since" Int :> Get '[Lucid.HTML] RecentActivityNewPartial + :<|> "partials" :> "recent-activity-more" :> QueryParam "offset" Int :> Get '[Lucid.HTML] RecentActivityMorePartial :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial :<|> "partials" :> "task-list" @@ -191,7 +193,9 @@ instance FromForm FactCreateForm where data EpicsPage = EpicsPage [TaskCore.Task] [TaskCore.Task] -data RecentActivityPartial = RecentActivityPartial [TaskCore.Task] Int Bool UTCTime +data RecentActivityNewPartial = RecentActivityNewPartial [TaskCore.Task] (Maybe Int) + +data RecentActivityMorePartial = RecentActivityMorePartial [TaskCore.Task] Int Bool newtype ReadyCountPartial = ReadyCountPartial Int @@ -545,22 +549,26 @@ instance Lucid.ToHtml HomePage where <| traverse_ renderListGroupItem (take 5 readyTasks) Lucid.h2_ "Recent Activity" + let newestTimestamp = maybe 0 taskToUnixTs (head recentTasks) Lucid.div_ [ Lucid.class_ "recent-activity", - Lucid.makeAttribute "hx-get" "/partials/recent-activity", - Lucid.makeAttribute "hx-trigger" "every 10s" + Lucid.id_ "recent-activity", + Lucid.makeAttribute "data-newest-ts" (tshow newestTimestamp), + Lucid.makeAttribute "hx-get" "/partials/recent-activity-new", + Lucid.makeAttribute "hx-trigger" "every 10s", + Lucid.makeAttribute "hx-vals" "js:{since: this.dataset.newestTs}", + Lucid.makeAttribute "hx-target" "#activity-list", + Lucid.makeAttribute "hx-swap" "afterbegin" ] <| do - if null recentTasks - then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." - else - Lucid.div_ [Lucid.class_ "list-group"] - <| traverse_ renderListGroupItem recentTasks + Lucid.div_ [Lucid.id_ "activity-list", Lucid.class_ "list-group"] + <| traverse_ renderListGroupItem recentTasks when hasMoreRecent <| Lucid.button_ - [ Lucid.class_ "btn btn-secondary load-more-btn", - Lucid.makeAttribute "hx-get" "/partials/recent-activity?offset=5", - Lucid.makeAttribute "hx-target" "closest .recent-activity", + [ Lucid.id_ "activity-load-more", + Lucid.class_ "btn btn-secondary load-more-btn", + Lucid.makeAttribute "hx-get" "/partials/recent-activity-more?offset=5", + Lucid.makeAttribute "hx-target" "#activity-list", Lucid.makeAttribute "hx-swap" "beforeend" ] "Load More" @@ -1607,22 +1615,36 @@ instance Lucid.ToHtml StatsPage where "" Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) -instance Lucid.ToHtml RecentActivityPartial where +instance Lucid.ToHtml RecentActivityNewPartial where toHtmlRaw = Lucid.toHtml - toHtml (RecentActivityPartial recentTasks nextOffset hasMore _now) = - if null recentTasks - then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." - else do - Lucid.div_ [Lucid.class_ "list-group"] - <| traverse_ renderListGroupItem recentTasks - when hasMore - <| Lucid.button_ - [ Lucid.class_ "btn btn-secondary load-more-btn", - Lucid.makeAttribute "hx-get" ("/partials/recent-activity?offset=" <> tshow nextOffset), - Lucid.makeAttribute "hx-target" "closest .recent-activity", - Lucid.makeAttribute "hx-swap" "beforeend" - ] - "Load More" + toHtml (RecentActivityNewPartial tasks maybeNewestTs) = do + traverse_ renderListGroupItem tasks + case maybeNewestTs of + Nothing -> pure () + Just ts -> + Lucid.div_ + [ Lucid.id_ "recent-activity", + Lucid.makeAttribute "data-newest-ts" (tshow ts), + Lucid.makeAttribute "hx-swap-oob" "attributes:#recent-activity data-newest-ts" + ] + "" + +instance Lucid.ToHtml RecentActivityMorePartial where + toHtmlRaw = Lucid.toHtml + toHtml (RecentActivityMorePartial tasks nextOffset hasMore) = do + traverse_ renderListGroupItem tasks + if hasMore + then + Lucid.button_ + [ Lucid.id_ "activity-load-more", + Lucid.class_ "btn btn-secondary load-more-btn", + Lucid.makeAttribute "hx-get" ("/partials/recent-activity-more?offset=" <> tshow nextOffset), + Lucid.makeAttribute "hx-target" "#activity-list", + Lucid.makeAttribute "hx-swap" "beforeend", + Lucid.makeAttribute "hx-swap-oob" "true" + ] + "Load More" + else Lucid.span_ [Lucid.id_ "activity-load-more", Lucid.makeAttribute "hx-swap-oob" "true"] "" instance Lucid.ToHtml ReadyCountPartial where toHtmlRaw = Lucid.toHtml @@ -1873,7 +1895,8 @@ server = :<|> taskAcceptHandler :<|> taskRejectHandler :<|> taskResetRetriesHandler - :<|> recentActivityHandler + :<|> recentActivityNewHandler + :<|> recentActivityMoreHandler :<|> readyCountHandler :<|> taskListPartialHandler :<|> taskMetricsPartialHandler @@ -2094,9 +2117,17 @@ server = TaskCore.updateTaskStatus tid TaskCore.Open [] pure <| addHeader ("/tasks/" <> tid) NoContent - recentActivityHandler :: Maybe Int -> Servant.Handler RecentActivityPartial - recentActivityHandler maybeOffset = do - now <- liftIO getCurrentTime + recentActivityNewHandler :: Maybe Int -> Servant.Handler RecentActivityNewPartial + recentActivityNewHandler maybeSince = do + allTasks <- liftIO TaskCore.loadTasks + let sinceTime = maybe (posixSecondsToUTCTime 0) (posixSecondsToUTCTime <. fromIntegral) maybeSince + sortedTasks = List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks + newTasks = filter (\t -> TaskCore.taskUpdatedAt t > sinceTime) sortedTasks + newestTs = maybe maybeSince (Just <. taskToUnixTs) (head newTasks) + pure (RecentActivityNewPartial newTasks newestTs) + + recentActivityMoreHandler :: Maybe Int -> Servant.Handler RecentActivityMorePartial + recentActivityMoreHandler maybeOffset = do allTasks <- liftIO TaskCore.loadTasks let offset = fromMaybe 0 maybeOffset pageSize = 5 @@ -2104,7 +2135,7 @@ server = pageTasks = take pageSize <| drop offset sortedTasks hasMore = length sortedTasks > offset + pageSize nextOffset = offset + pageSize - pure (RecentActivityPartial pageTasks nextOffset hasMore now) + pure (RecentActivityMorePartial pageTasks nextOffset hasMore) readyCountHandler :: Servant.Handler ReadyCountPartial readyCountHandler = do @@ -2128,6 +2159,9 @@ server = maybeRetry <- liftIO (TaskCore.getRetryContext tid) pure (TaskMetricsPartial tid activities maybeRetry now) +taskToUnixTs :: TaskCore.Task -> Int +taskToUnixTs t = round (utcTimeToPOSIXSeconds (TaskCore.taskUpdatedAt t)) + getReviewInfo :: Text -> IO ReviewInfo getReviewInfo tid = do maybeCommit <- findCommitForTask tid |