diff options
Diffstat (limited to 'Omni/Jr')
| -rw-r--r-- | Omni/Jr/Web.hs | 66 |
1 files changed, 59 insertions, 7 deletions
diff --git a/Omni/Jr/Web.hs b/Omni/Jr/Web.hs index 6c30be3..17849f4 100644 --- a/Omni/Jr/Web.hs +++ b/Omni/Jr/Web.hs @@ -23,6 +23,7 @@ import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText import Data.Time (UTCTime, defaultTimeLocale, formatTime) import qualified Lucid +import qualified Lucid.Base as Lucid import qualified Network.Wai.Handler.Warp as Warp import qualified Omni.Jr.Web.Style as Style import qualified Omni.Task.Core as TaskCore @@ -62,6 +63,8 @@ type API = :<|> "tasks" :> Capture "id" Text :> "review" :> Get '[Lucid.HTML] TaskReviewPage :<|> "tasks" :> Capture "id" Text :> "accept" :> PostRedirect :<|> "tasks" :> Capture "id" Text :> "reject" :> ReqBody '[FormUrlEncoded] RejectForm :> PostRedirect + :<|> "partials" :> "recent-activity" :> Get '[Lucid.HTML] RecentActivityPartial + :<|> "partials" :> "ready-count" :> Get '[Lucid.HTML] ReadyCountPartial data CSS @@ -96,6 +99,10 @@ data ReviewInfo data StatsPage = StatsPage TaskCore.TaskStats (Maybe Text) +newtype RecentActivityPartial = RecentActivityPartial [TaskCore.Task] + +newtype ReadyCountPartial = ReadyCountPartial Int + newtype RejectForm = RejectForm (Maybe Text) instance FromForm RejectForm where @@ -127,6 +134,12 @@ pageHead title = Lucid.content_ "width=device-width, initial-scale=1" ] Lucid.link_ [Lucid.rel_ "stylesheet", Lucid.href_ "/style.css"] + Lucid.script_ + [ Lucid.src_ "https://unpkg.com/htmx.org@2.0.4", + Lucid.integrity_ "sha384-HGfztofotfshcF7+8n44JQL2oJmowVChPTg48S+jvZoztPfvwD79OC/LTtG6dMp+", + Lucid.crossorigin_ "anonymous" + ] + ("" :: Text) navbar :: (Monad m) => Lucid.HtmlT m () navbar = @@ -190,8 +203,14 @@ instance Lucid.ToHtml HomePage where Lucid.h2_ <| do "Ready Queue " - Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] - <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)") + Lucid.span_ + [ Lucid.class_ "ready-count", + Lucid.makeAttribute "hx-get" "/partials/ready-count", + Lucid.makeAttribute "hx-trigger" "every 5s" + ] + <| do + Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] + <| Lucid.toHtml ("(" <> tshow (length readyTasks) <> " tasks)") if null readyTasks then Lucid.p_ [Lucid.class_ "empty-msg"] "No tasks ready for work." else @@ -199,11 +218,16 @@ instance Lucid.ToHtml HomePage where <| traverse_ renderTaskCard (take 5 readyTasks) Lucid.h2_ "Recent Activity" - if null recentTasks - then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." - else - Lucid.div_ [Lucid.class_ "task-list"] - <| traverse_ renderTaskCard recentTasks + Lucid.div_ + [ Lucid.class_ "recent-activity", + Lucid.makeAttribute "hx-get" "/partials/recent-activity", + Lucid.makeAttribute "hx-trigger" "every 10s" + ] + <| if null recentTasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." + else + Lucid.div_ [Lucid.class_ "task-list"] + <| traverse_ renderTaskCard recentTasks where statCard :: (Monad m) => Text -> Int -> Text -> Text -> Lucid.HtmlT m () statCard label count badgeClass href = @@ -688,6 +712,21 @@ instance Lucid.ToHtml StatsPage where "" Lucid.span_ [Lucid.class_ "stats-count"] (Lucid.toHtml (tshow count)) +instance Lucid.ToHtml RecentActivityPartial where + toHtmlRaw = Lucid.toHtml + toHtml (RecentActivityPartial recentTasks) = + if null recentTasks + then Lucid.p_ [Lucid.class_ "empty-msg"] "No recent tasks." + else + Lucid.div_ [Lucid.class_ "task-list"] + <| traverse_ renderTaskCard recentTasks + +instance Lucid.ToHtml ReadyCountPartial where + toHtmlRaw = Lucid.toHtml + toHtml (ReadyCountPartial count) = + Lucid.a_ [Lucid.href_ "/ready", Lucid.class_ "ready-link"] + <| Lucid.toHtml ("(" <> tshow count <> " tasks)") + -- | Simple markdown renderer for epic descriptions -- Supports: headers (#, ##, ###), lists (- or *), code blocks (```), inline code (`) renderMarkdown :: (Monad m) => Text -> Lucid.HtmlT m () @@ -817,6 +856,8 @@ server = :<|> taskReviewHandler :<|> taskAcceptHandler :<|> taskRejectHandler + :<|> recentActivityHandler + :<|> readyCountHandler where styleHandler :: Servant.Handler LazyText.Text styleHandler = pure Style.css @@ -949,6 +990,17 @@ server = TaskCore.updateTaskStatus tid TaskCore.Open [] pure <| addHeader ("/tasks/" <> tid) NoContent + recentActivityHandler :: Servant.Handler RecentActivityPartial + recentActivityHandler = do + allTasks <- liftIO TaskCore.loadTasks + let recentTasks = take 5 <| List.sortBy (flip compare `on` TaskCore.taskUpdatedAt) allTasks + pure (RecentActivityPartial recentTasks) + + readyCountHandler :: Servant.Handler ReadyCountPartial + readyCountHandler = do + readyTasks <- liftIO TaskCore.getReadyTasks + pure (ReadyCountPartial (length readyTasks)) + getReviewInfo :: Text -> IO ReviewInfo getReviewInfo tid = do maybeCommit <- findCommitForTask tid |