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:
+8
-8
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user