diff --git a/app/Main.hs b/app/Main.hs index 3106412..dcf4f94 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Sis/Page/Activity.hs b/src/Sis/Page/Activity.hs index c6ecd13..5f935d1 100644 --- a/src/Sis/Page/Activity.hs +++ b/src/Sis/Page/Activity.hs @@ -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)) diff --git a/src/Sis/Page/Chores.hs b/src/Sis/Page/Chores.hs index f3c976e..c64a8b6 100644 --- a/src/Sis/Page/Chores.hs +++ b/src/Sis/Page/Chores.hs @@ -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)) diff --git a/src/Sis/Page/Dashboard.hs b/src/Sis/Page/Dashboard.hs index a98b52b..e0e1529 100644 --- a/src/Sis/Page/Dashboard.hs +++ b/src/Sis/Page/Dashboard.hs @@ -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) diff --git a/src/Sis/Page/Household.hs b/src/Sis/Page/Household.hs index 36e2db2..1426ecb 100644 --- a/src/Sis/Page/Household.hs +++ b/src/Sis/Page/Household.hs @@ -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)) diff --git a/src/Sis/Page/Login.hs b/src/Sis/Page/Login.hs index 362a041..b9a7cc0 100644 --- a/src/Sis/Page/Login.hs +++ b/src/Sis/Page/Login.hs @@ -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 diff --git a/src/Sis/Page/Signup.hs b/src/Sis/Page/Signup.hs index d50738b..8a30823 100644 --- a/src/Sis/Page/Signup.hs +++ b/src/Sis/Page/Signup.hs @@ -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 diff --git a/src/Sis/Route.hs b/src/Sis/Route.hs index df6c1a6..81c0ecc 100644 --- a/src/Sis/Route.hs +++ b/src/Sis/Route.hs @@ -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 diff --git a/src/Sis/View/Layout.hs b/src/Sis/View/Layout.hs index 4a88822..6b4559f 100644 --- a/src/Sis/View/Layout.hs +++ b/src/Sis/View/Layout.hs @@ -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