fix: rename route constructors to avoid type conflicts

- Renamed route constructors: RouteLogin → RLogin, RouteDashboard → RDashboard, etc.
- This fixes ambiguous occurrence errors with Types.Dashboard vs Route.Dashboard
- Fixed Layout.hs navbar links to use new constructor names
- Server verified serving HTML on /login, /rdashboard, etc.
This commit is contained in:
2026-07-16 06:54:18 -04:00
parent 1d5ecd0829
commit df9ad3d7c4
9 changed files with 32 additions and 32 deletions
+8 -8
View File
@@ -47,11 +47,11 @@ main = do
Warp.run port $ app
router :: (Hyperbole :> es, DB :> es, IOE :> es) => AppRoute -> Eff es Response
router RouteHome = do
redirect (routeUri RouteDashboard)
router RouteLogin = runPage Sis.Page.Login.page
router RouteSignup = runPage Sis.Page.Signup.page
router RouteDashboard = runPage Sis.Page.Dashboard.page
router RouteChores = runPage Sis.Page.Chores.page
router RouteHousehold = runPage Sis.Page.Household.page
router RouteActivity = runPage Sis.Page.Activity.page
router Home = do
redirect (routeUri RDashboard)
router RLogin = runPage Sis.Page.Login.page
router RSignup = runPage Sis.Page.Signup.page
router RDashboard = runPage Sis.Page.Dashboard.page
router RChores = runPage Sis.Page.Chores.page
router RHousehold = runPage Sis.Page.Household.page
router RActivity = runPage Sis.Page.Activity.page
+1 -1
View File
@@ -89,7 +89,7 @@ page = do
mSession <- lookupSession @UserSession
case mSession of
Nothing -> do
redirect (routeUri RouteLogin)
redirect (routeUri RLogin)
pure $ hyper ActivityPage $ el "Redirecting..."
Just us -> do
hhs <- getUserHouseholds (UserId (usUserId us))
+1 -1
View File
@@ -86,7 +86,7 @@ page = do
mSession <- lookupSession @UserSession
case mSession of
Nothing -> do
redirect (routeUri RouteLogin)
redirect (routeUri RLogin)
pure $ hyper ChoresPage $ el "Redirecting..."
Just us -> do
hhs <- getUserHouseholds (UserId (usUserId us))
+2 -2
View File
@@ -63,7 +63,7 @@ dashboardView dash = do
if null (dashCompletedItems dash)
then el @ att "style" "opacity:0.5" $ text "No activity recorded today."
else el @ att "class" nbBoxClass $ mapM_ completedItemRow (dashCompletedItems dash)
route RouteActivity $ text "View Full Activity Log"
route RActivity $ text "View Full Activity Log"
statTile :: Text -> Text -> Text -> View ctx ()
statTile label count color = do
@@ -102,7 +102,7 @@ page = do
mSession <- lookupSession @UserSession
case mSession of
Nothing -> do
redirect (routeUri RouteLogin)
redirect (routeUri RLogin)
pure $ hyper DashboardPage $ el "Redirecting..."
Just us -> do
today <- liftIO (utctDay <$> getCurrentTime)
+1 -1
View File
@@ -111,7 +111,7 @@ page = do
mSession <- lookupSession @UserSession
case mSession of
Nothing -> do
redirect (routeUri RouteLogin)
redirect (routeUri RLogin)
pure $ hyper HouseholdPage $ el "Redirecting..."
Just us -> do
hhs <- getUserHouseholds (UserId (usUserId us))
+3 -3
View File
@@ -31,7 +31,7 @@ instance (DB :> es, IOE :> es) => HyperView LoginPage es where
Just u
| verifyPassword (lfPassword formData') (userPasswordHash u) -> do
saveSession (UserSession (unUserId (userId u)))
redirect (routeUri RouteDashboard)
redirect (routeUri RDashboard)
pure $ hyper LoginPage $ el "Redirecting..."
_ -> pure (loginView (Just "Invalid email or password"))
update Noop = pure $ hyper LoginPage $ loginView Nothing
@@ -54,12 +54,12 @@ loginView mError = do
tag "input" @ att "type" "checkbox" . att "name" "lfRemember" $ none
text "Remember me"
submit (text "Log In") @ att "class" nbButtonClass @ att "style" "width:100%"
route RouteSignup $ text "Don't have an account? Sign Up"
route RSignup $ text "Don't have an account? Sign Up"
page :: (Hyperbole :> es, DB :> es, IOE :> es) => Page es '[LoginPage]
page = do
mSession <- lookupSession @UserSession
case mSession of
Just _ -> do
redirect (routeUri RouteDashboard)
redirect (routeUri RDashboard)
pure $ hyper LoginPage $ el "Redirecting..."
Nothing -> pure $ hyper LoginPage $ loginView Nothing
+3 -3
View File
@@ -39,7 +39,7 @@ instance (DB :> es, IOE :> es) => HyperView SignupPage es where
pwHash <- liftIO (hashPassword (sfPassword form))
uid <- createUser (sfDisplayName form) (sfEmail form) pwHash
saveSession (UserSession (unUserId uid))
redirect (routeUri RouteDashboard)
redirect (routeUri RDashboard)
pure $ hyper SignupPage $ el "Redirecting..."
signupView :: Maybe Text -> View SignupPage ()
signupView mError = do
@@ -64,12 +64,12 @@ signupView mError = do
tag "input" @ att "type" "checkbox" . att "name" "sfAgree" $ none
text "I agree to the terms of service"
submit (text "Sign Up") @ att "class" nbButtonClass @ att "style" "width:100%"
route RouteLogin $ text "Already have an account? Log In"
route RLogin $ text "Already have an account? Log In"
page :: (Hyperbole :> es, DB :> es, IOE :> es) => Page es '[SignupPage]
page = do
mSession <- lookupSession @UserSession
case mSession of
Just _ -> do
redirect (routeUri RouteDashboard)
redirect (routeUri RDashboard)
pure $ hyper SignupPage $ el "Redirecting..."
Nothing -> pure $ hyper SignupPage $ signupView Nothing
+8 -8
View File
@@ -7,14 +7,14 @@ import GHC.Generics (Generic)
import Web.Hyperbole.Route
data AppRoute
= RouteHome
| RouteLogin
| RouteSignup
| RouteDashboard
| RouteChores
| RouteHousehold
| RouteActivity
= Home
| RLogin
| RSignup
| RDashboard
| RChores
| RHousehold
| RActivity
deriving stock (Eq, Generic, Show)
instance Route AppRoute where
baseRoute = Just RouteHome
baseRoute = Just Home
+5 -5
View File
@@ -59,11 +59,11 @@ navbar = do
el @ att "class" "nb-navbar-start" $ do
el @ att "class" nbFontHeading2Class @ att "style" "font-weight:700" $ text "Sis"
el @ att "class" "nb-navbar-end" $ do
routeLink RouteDashboard "Dashboard"
routeLink RouteChores "Chores"
routeLink RouteHousehold "Household"
routeLink RouteActivity "Activity"
routeLink RouteLogin "Logout"
routeLink RDashboard "Dashboard"
routeLink RChores "Chores"
routeLink RHousehold "Household"
routeLink RActivity "Activity"
routeLink RLogin "Logout"
routeLink :: (Route r) => r -> Text -> View ctx ()
routeLink rt lbl = do