jbrechtel
6bea83be7d
HyperView update actions replace only the hyper component — without pageLayout the navbar disappears after any interactive action (create chore, navigate pages, refresh, create household, etc.). Every hyper-returning update now wraps the view in pageLayout us.
108 lines
4.6 KiB
Haskell
108 lines
4.6 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-do-bind -Wno-name-shadowing -Wno-redundant-constraints -Wno-redundant-constraints #-}
|
|
|
|
module Sis.Page.Activity (page) where
|
|
|
|
import Data.Text (Text)
|
|
import Data.Text qualified as T
|
|
import Effectful
|
|
|
|
import Sis.Database
|
|
import Sis.Route
|
|
import Sis.Style (colorGreen, colorRed, colorYellow, nbBadgeClass, nbBoxClass, nbButtonDefaultClass, nbContainerClass, nbHeadingClass, nbInputClass, nbLabelClass, nbListItemClass)
|
|
import Sis.Types
|
|
import Sis.View.Layout
|
|
import Web.Hyperbole
|
|
import Web.Hyperbole.Effect.Session
|
|
import Web.Hyperbole.Page
|
|
|
|
data ActivityPage = ActivityPage
|
|
deriving stock (Generic)
|
|
deriving anyclass (ViewId)
|
|
|
|
instance (DB :> es, IOE :> es) => HyperView ActivityPage es where
|
|
data Action ActivityPage
|
|
= RefreshActivity
|
|
| GoToPage Int
|
|
deriving stock (Generic)
|
|
deriving anyclass (ViewAction)
|
|
|
|
update RefreshActivity = do
|
|
update (GoToPage 1)
|
|
update (GoToPage pageNum) = do
|
|
mUser <- lookupSession @UserSession
|
|
case mUser of
|
|
Nothing -> pure (el "Not authenticated")
|
|
Just us -> do
|
|
hhs <- getUserHouseholds (UserId (usUserId us))
|
|
case hhs of
|
|
[] -> pure $ hyper ActivityPage $ pageLayout us $ el "No households"
|
|
(h : _) -> do
|
|
log <- getActivityLog (unHouseholdId (householdId h)) pageNum 20
|
|
pure $ hyper ActivityPage $ pageLayout us $ activityView log
|
|
|
|
activityView :: ActivityLogPage -> View ActivityPage ()
|
|
activityView log = do
|
|
el @ att "class" nbContainerClass @ att "style" "max-width:960px;margin:0 auto" $ do
|
|
el @ att "class" nbHeadingClass $ text "Activity Log"
|
|
if null (alpEntries log)
|
|
then el @ att "style" "opacity:0.5" $ text "No activity recorded yet."
|
|
else el @ att "class" nbBoxClass $ mapM_ entryRow (alpEntries log)
|
|
if alpTotal log > alpPerPage log
|
|
then el @ att "style" "margin-top:1rem;display:flex;gap:0.5rem;justify-content:center" $ do
|
|
let totalPages = (alpTotal log + alpPerPage log - 1) `div` alpPerPage log
|
|
if alpPage log > 1
|
|
then button (GoToPage (alpPage log - 1)) @ att "class" nbButtonDefaultClass $ text "Previous"
|
|
else none
|
|
el @ att "style" "align-self:center" $
|
|
text ("Page " <> T.pack (show (alpPage log)) <> " of " <> T.pack (show totalPages))
|
|
if alpPage log < totalPages
|
|
then button (GoToPage (alpPage log + 1)) @ att "class" nbButtonDefaultClass $ text "Next"
|
|
else none
|
|
else none
|
|
|
|
entryRow :: ActivityLogEntry -> View ActivityPage ()
|
|
entryRow e = do
|
|
let act = aleActivity e
|
|
statusText = case activityStatus act of
|
|
ActivityCompleted -> "COMPLETED"
|
|
ActivitySkipped -> "SKIPPED"
|
|
statusColor = case activityStatus act of
|
|
ActivityCompleted -> colorGreen
|
|
ActivitySkipped -> "var(--nb-orange)"
|
|
el @ att "class" nbListItemClass @ att "style" "padding:0.5rem" $ do
|
|
el @ att "class" nbBadgeClass @ att "style" ("margin-right:0.5rem;background:" <> statusColor <> ";color:#000") $
|
|
text statusText
|
|
el @ att "style" "font-weight:500" $ text (aleUserName e)
|
|
text (" " <> statusText <> " ")
|
|
el @ att "style" "font-weight:500" $ text (aleChoreName e)
|
|
el @ att "style" "opacity:0.5" $
|
|
text ("on " <> T.pack (show (aleOccurrenceDate e)))
|
|
case activityNote act of
|
|
Just note ->
|
|
el @ att "style" "opacity:0.5;font-style:italic;margin-left:0.5rem" $
|
|
text ("\"" <> note <> "\"")
|
|
Nothing -> none
|
|
|
|
page :: (Hyperbole :> es, DB :> es, IOE :> es) => Page es '[ActivityPage]
|
|
page = do
|
|
mSession <- lookupSession @UserSession
|
|
case mSession of
|
|
Nothing -> do
|
|
redirect (routeUri RLogin)
|
|
Just us -> do
|
|
hhs <- getUserHouseholds (UserId (usUserId us))
|
|
case hhs of
|
|
[] -> pure $ hyper ActivityPage $ pageLayout us $ el "No households"
|
|
(h : _) -> do
|
|
log <- getActivityLog (unHouseholdId (householdId h)) 1 20
|
|
pure $ hyper ActivityPage $ pageLayout us $ activityView log
|