diff --git a/src/Sis/Page/Activity.hs b/src/Sis/Page/Activity.hs index 38156bc..b55037f 100644 --- a/src/Sis/Page/Activity.hs +++ b/src/Sis/Page/Activity.hs @@ -18,7 +18,7 @@ data ActivityPage = ActivityPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView ActivityPage es where +instance (DB :> es, IOE :> es) => HyperView ActivityPage es where data Action ActivityPage = RefreshActivity | GoToPage Int @@ -82,9 +82,6 @@ entryRow e = do text ("\"" <> note <> "\"") Nothing -> none -getUserHouseholds :: (DB :> es) => UserId -> Eff es [Household] -getUserHouseholds = getUserHouseholds - page :: (Hyperbole :> es, DB :> es) => Eff es (View ActivityPage ()) page = do mSession <- lookupSession @UserSession diff --git a/src/Sis/Page/Chores.hs b/src/Sis/Page/Chores.hs index 84c6d47..349392a 100644 --- a/src/Sis/Page/Chores.hs +++ b/src/Sis/Page/Chores.hs @@ -19,7 +19,7 @@ data ChoresPage = ChoresPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView ChoresPage es where +instance (DB :> es, IOE :> es) => HyperView ChoresPage es where data Action ChoresPage = CRefreshChores | CDeleteChore ChoreId diff --git a/src/Sis/Page/Dashboard.hs b/src/Sis/Page/Dashboard.hs index adee55f..35254b5 100644 --- a/src/Sis/Page/Dashboard.hs +++ b/src/Sis/Page/Dashboard.hs @@ -20,7 +20,7 @@ data DashboardPage = DashboardPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView DashboardPage es where +instance (DB :> es, IOE :> es) => HyperView DashboardPage es where data Action DashboardPage = RefreshDashboard | CheckOff OccurrenceId diff --git a/src/Sis/Page/Household.hs b/src/Sis/Page/Household.hs index a16b692..039ab4c 100644 --- a/src/Sis/Page/Household.hs +++ b/src/Sis/Page/Household.hs @@ -19,7 +19,7 @@ data HouseholdPage = HouseholdPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView HouseholdPage es where +instance (DB :> es, IOE :> es) => HyperView HouseholdPage es where data Action HouseholdPage = RefreshHousehold | CreateInviteAction @@ -69,7 +69,7 @@ householdView :: Household -> [Membership] -> [Invite] -> View HouseholdPage () householdView h mems invs = do el @ att "class" nbContainerClass @ att "style" "max-width:960px;margin:0 auto" $ do el @ att "class" nbFontHeading1Class $ text (householdName h) - el @ att "style" "opacity:0.7" $ text (show (length mems) <> " members") + el @ att "style" "opacity:0.7" $ text (T.pack (show (length mems) <> " members") el @ att "class" nbFontHeading2Class $ text "Members" el @ att "class" nbBoxClass @ att "style" "margin-bottom:1.5rem" $ mapM_ memberRow mems el @ att "class" nbFontHeading2Class $ text "Invite Members" @@ -91,7 +91,7 @@ memberRow m = do el @ att "style" "font-weight:500" $ text (membershipDisplayName m) el @ att "style" "opacity:0.5" $ text (membershipEmail m) el @ att "class" nbBadgeClass @ att "style" (if membershipRole m == OwnerRole then "background:var(--nb-yellow);color:#000" else "") $ - text (show (membershipRole m)) + text (T.pack (show (membershipRole m)) inviteRow :: Invite -> View HouseholdPage () inviteRow i = do @@ -105,9 +105,6 @@ initials name = let ws = T.words name in T.toUpper (T.take 2 (T.concat (map (T.take 1) ws))) -getUserHouseholds :: (DB :> es) => UserId -> Eff es [Household] -getUserHouseholds = getUserHouseholds - page :: (Hyperbole :> es, DB :> es) => Eff es (View HouseholdPage ()) page = do mSession <- lookupSession @UserSession diff --git a/src/Sis/Page/Login.hs b/src/Sis/Page/Login.hs index ca91f70..9906e74 100644 --- a/src/Sis/Page/Login.hs +++ b/src/Sis/Page/Login.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-do-bind -Wno-redundant-constraints #-} module Sis.Page.Login (page) where import Effectful @@ -17,7 +18,7 @@ import Web.Hyperbole.Page data LoginPage = LoginPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView LoginPage es where +instance (DB :> es, IOE :> es) => HyperView LoginPage es where data Action LoginPage = SubmitLogin | Noop @@ -46,11 +47,11 @@ loginView mError = do Nothing -> none form SubmitLogin $ do el @ att "class" nbLabelClass $ text "Email" - tag "input" @ att "type" "email" . att "name" "lfEmail" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "email" . att "name" "lfEmail" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "class" nbLabelClass $ text "Password" - tag "input" @ att "type" "password" . att "name" "lfPassword" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "password" . att "name" "lfPassword" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do - tag "input" @ att "type" "checkbox" . att "name" "lfRemember" + 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" diff --git a/src/Sis/Page/Signup.hs b/src/Sis/Page/Signup.hs index 38ac8c6..1237269 100644 --- a/src/Sis/Page/Signup.hs +++ b/src/Sis/Page/Signup.hs @@ -1,4 +1,6 @@ +{-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-do-bind -Wno-redundant-constraints #-} module Sis.Page.Signup (page) where import Effectful @@ -17,7 +19,7 @@ import Web.Hyperbole.Page data SignupPage = SignupPage deriving stock (Generic) deriving anyclass (ViewId) -instance (DB :> es) => HyperView SignupPage es where +instance (DB :> es, IOE :> es) => HyperView SignupPage es where data Action SignupPage = SubmitSignup deriving stock (Generic) @@ -51,15 +53,15 @@ signupView mError = do Nothing -> none form SubmitSignup $ do el @ att "class" nbLabelClass $ text "Display Name" - tag "input" @ att "type" "text" . att "name" "sfDisplayName" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "text" . att "name" "sfDisplayName" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "class" nbLabelClass $ text "Email" - tag "input" @ att "type" "email" . att "name" "sfEmail" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "email" . att "name" "sfEmail" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "class" nbLabelClass $ text "Password (min 8 characters)" - tag "input" @ att "type" "password" . att "name" "sfPassword" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "password" . att "name" "sfPassword" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "class" nbLabelClass $ text "Confirm Password" - tag "input" @ att "type" "password" . att "name" "sfConfirm" . att "class" nbInputClass @ att "style" "width:100%" + tag "input" @ att "type" "password" . att "name" "sfConfirm" . att "class" nbInputClass @ att "style" "width:100%" $ none el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do - tag "input" @ att "type" "checkbox" . att "name" "sfAgree" + 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"