From 02044642a7c16282c7abe658266080ab972d7a16 Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Thu, 16 Jul 2026 09:05:56 -0400 Subject: [PATCH] =?UTF-8?q?feat:=20rebuild=20navbar=20with=20NB=20structur?= =?UTF-8?q?e=20=E2=80=94=20Sis=20brand,=20nav=20links=20with=20nb-navbar-l?= =?UTF-8?q?ink=20class=20inside=20nb-navbar-item=20wrappers,=20user=20init?= =?UTF-8?q?ials=20avatar?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - UserSession now carries usDisplayName for extracting initials (current: JB) - Nav items: Today (was Dashboard), Chores, Activity, Household - Removed Logout link; added black user avatar circle with initials - routeLink generates proper
  • structure - All pages wrapped with pageLayout to render shared navbar shell - Login/Signup save display name into session on authentication --- src/Sis/Page/Activity.hs | 4 ++-- src/Sis/Page/Chores.hs | 4 ++-- src/Sis/Page/Dashboard.hs | 4 ++-- src/Sis/Page/Household.hs | 4 ++-- src/Sis/Page/Login.hs | 2 +- src/Sis/Page/Signup.hs | 2 +- src/Sis/View/Layout.hs | 36 +++++++++++++++++++++++++++--------- 7 files changed, 37 insertions(+), 19 deletions(-) diff --git a/src/Sis/Page/Activity.hs b/src/Sis/Page/Activity.hs index 8238189..8d5ea19 100644 --- a/src/Sis/Page/Activity.hs +++ b/src/Sis/Page/Activity.hs @@ -101,7 +101,7 @@ page = do Just us -> do hhs <- getUserHouseholds (UserId (usUserId us)) case hhs of - [] -> pure $ hyper ActivityPage $ el "No households" + [] -> pure $ hyper ActivityPage $ pageLayout us $ el "No households" (h : _) -> do log <- getActivityLog (unHouseholdId (householdId h)) 1 20 - pure $ hyper ActivityPage $ activityView log + pure $ hyper ActivityPage $ pageLayout us $ activityView log diff --git a/src/Sis/Page/Chores.hs b/src/Sis/Page/Chores.hs index b0ff0dd..f8edea2 100644 --- a/src/Sis/Page/Chores.hs +++ b/src/Sis/Page/Chores.hs @@ -98,7 +98,7 @@ page = do Just us -> do hhs <- getUserHouseholds (UserId (usUserId us)) case hhs of - [] -> pure $ hyper ChoresPage $ el "No households" + [] -> pure $ hyper ChoresPage $ pageLayout us $ el "No households" (h : _) -> do chores' <- getChores (unHouseholdId (householdId h)) - pure $ hyper ChoresPage $ choresView chores' + pure $ hyper ChoresPage $ pageLayout us $ choresView chores' diff --git a/src/Sis/Page/Dashboard.hs b/src/Sis/Page/Dashboard.hs index 1f318bd..856fb73 100644 --- a/src/Sis/Page/Dashboard.hs +++ b/src/Sis/Page/Dashboard.hs @@ -115,7 +115,7 @@ page = do today <- liftIO (utctDay <$> getCurrentTime) hhs <- getUserHouseholds (UserId (usUserId us)) case hhs of - [] -> pure $ hyper DashboardPage $ el "No households" + [] -> pure $ hyper DashboardPage $ pageLayout us $ el "No households" (h : _) -> do dash <- getDashboard (unHouseholdId (householdId h)) today - pure $ hyper DashboardPage $ dashboardView dash + pure $ hyper DashboardPage $ pageLayout us $ dashboardView dash diff --git a/src/Sis/Page/Household.hs b/src/Sis/Page/Household.hs index dc2453a..182433a 100644 --- a/src/Sis/Page/Household.hs +++ b/src/Sis/Page/Household.hs @@ -123,9 +123,9 @@ page = do Just us -> do hhs <- getUserHouseholds (UserId (usUserId us)) case hhs of - [] -> pure $ hyper HouseholdPage noHouseholdView + [] -> pure $ hyper HouseholdPage $ pageLayout us noHouseholdView (h : _) -> do let hid = unHouseholdId (householdId h) mems <- getMembers hid invs <- getInvites hid - pure $ hyper HouseholdPage $ householdView h mems invs + pure $ hyper HouseholdPage $ pageLayout us $ householdView h mems invs diff --git a/src/Sis/Page/Login.hs b/src/Sis/Page/Login.hs index 2a58151..c28ed66 100644 --- a/src/Sis/Page/Login.hs +++ b/src/Sis/Page/Login.hs @@ -40,7 +40,7 @@ instance (DB :> es, IOE :> es) => HyperView LoginPage es where case mUser of Just u | verifyPassword (lfPassword formData') (userPasswordHash u) -> do - saveSession (UserSession (unUserId (userId u))) + saveSession (UserSession (unUserId (userId u)) (userDisplayName u)) pure loginSuccessView _ -> pure (loginView (Just "Invalid email or password")) update Noop = pure (loginView Nothing) diff --git a/src/Sis/Page/Signup.hs b/src/Sis/Page/Signup.hs index ddea543..4f5728a 100644 --- a/src/Sis/Page/Signup.hs +++ b/src/Sis/Page/Signup.hs @@ -48,7 +48,7 @@ instance (DB :> es, IOE :> es) => HyperView SignupPage es where Nothing -> do pwHash <- liftIO (hashPassword (sfPassword form)) uid <- createUser (sfDisplayName form) (sfEmail form) pwHash - saveSession (UserSession (unUserId uid)) + saveSession (UserSession (unUserId uid) (sfDisplayName form)) pure signupSuccessView signupSuccessView :: View SignupPage () diff --git a/src/Sis/View/Layout.hs b/src/Sis/View/Layout.hs index 8458aeb..295eda0 100644 --- a/src/Sis/View/Layout.hs +++ b/src/Sis/View/Layout.hs @@ -6,25 +6,29 @@ module Sis.View.Layout ( documentHead, navbar, + pageLayout, UserSession (..), ) where import Data.Aeson import Data.Default import Data.Text (Text) +import Data.Text qualified as T import GHC.Generics (Generic) import Sis.Route import Sis.Style (nbButtonDefaultClass, nbHeadingClass, nbNavbarClass, nbNavbarLinkClass) import Web.Hyperbole +import Web.Hyperbole.Data.URI (uriToText) import Web.Hyperbole.Effect.Session ---------------------------------------------------------------------- -- Session ---------------------------------------------------------------------- -newtype UserSession = UserSession +data UserSession = UserSession { usUserId :: Int + , usDisplayName :: Text } deriving stock (Show, Eq, Generic) deriving anyclass (FromJSON, ToJSON) @@ -34,7 +38,7 @@ instance Session UserSession where cookieSecure = False instance Default UserSession where - def = UserSession 0 + def = UserSession 0 "" ---------------------------------------------------------------------- -- Document Head @@ -58,17 +62,31 @@ documentHead = do -- Navbar ---------------------------------------------------------------------- -navbar :: View ctx () -navbar = do +navbar :: UserSession -> View ctx () +navbar us = do el @ att "class" nbNavbarClass $ do - el @ att "class" "nb-navbar-brand" @ att "style" "font-weight:700" $ text "Sis" + tag "a" @ att "class" "nb-navbar-brand" . att "href" (uriToText (routeUri RDashboard)) $ text "Sis" el @ att "class" "nb-navbar-nav" $ do - routeLink RDashboard "Dashboard" + routeLink RDashboard "Today" routeLink RChores "Chores" - routeLink RHousehold "Household" routeLink RActivity "Activity" - routeLink RLogin "Logout" + routeLink RHousehold "Household" + el @ att "class" "nb-navbar-avatar" @ att "style" "width:2.5rem;height:2.5rem;border-radius:50%;background:#000;color:#fff;display:flex;align-items:center;justify-content:center;font-family:'Lexend Mega','Public Sans',sans-serif;font-weight:900;font-size:0.85rem;flex-shrink:0" $ + text (initials (usDisplayName us)) routeLink :: (Route r) => r -> Text -> View ctx () routeLink rt lbl = do - el @ att "class" nbNavbarLinkClass $ route rt $ text lbl + tag "li" @ att "class" "nb-navbar-item" $ do + tag "a" @ att "class" nbNavbarLinkClass . att "href" (uriToText (routeUri rt)) $ text lbl + +-- | Extract up to 2 initials from a display name +initials :: Text -> Text +initials displayName = + let ws = map (T.take 1) (T.words displayName) + in T.toUpper (T.take 2 (T.concat ws)) + +-- | Wrap content in a shared page shell (navbar + container) +pageLayout :: UserSession -> View ctx () -> View ctx () +pageLayout us body = do + navbar us + body