feat: Hyperbole port - all modules created, Database effect working

- Database.hs: effectful DB effect with all operations + convenience wrappers
- Types.hs: stripped Aeson (kept ToJSON/FromJSON on IDs), added form types
- Route.hs, Style.hs, View/Layout.hs: support modules
- All Page modules: Login, Signup, Dashboard, Chores, Household, Activity
- Main.hs: Hyperbole app entry point with router
- Known issue: Hyperbole view DSL syntax needs cleanup in page modules
  (tag calls need $ none suffix, form elements need field wrappers)

app/Main.hs

@@ -1,74 +1,55 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-{- | Entry point for the Sis server.
+module Main where
-
-Starts a Warp HTTP server, serves the JSON API and the SPA frontend.
--}
-module Main (main) where
 
+import Effectful
 import Network.Wai.Handler.Warp qualified as Warp
-import Options.Applicative qualified as Opt
+import Network.Wai.Middleware.Static qualified as Static
-import System.Posix.Signals qualified as Signals
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
 
-import Sis.Database qualified as Database
+import Sis.Database
-import Sis.Server qualified as Sis
+import Sis.Page.Activity
-
+import Sis.Page.Chores
-data Options = Options
+import Sis.Page.Dashboard
-    { optPort :: Int
+import Sis.Page.Household
-    , optStaticDir :: FilePath
+import Sis.Page.Login
-    , optDbPath :: FilePath
+import Sis.Page.Signup
-    }
+import Sis.Route
-
+import Sis.View.Layout (documentHead)
-optionsParser :: Opt.Parser Options
+import Web.Hyperbole
-optionsParser =
+import Web.Hyperbole.Application
-    Options
+import Web.Hyperbole.Effect.Response
-        <$> Opt.option
+import Web.Hyperbole.Page
-            Opt.auto
+import Web.Hyperbole.Route
-            ( Opt.long "port"
-                <> Opt.short 'p'
-                <> Opt.metavar "PORT"
-                <> Opt.help "Listen port"
-                <> Opt.value 8080
-                <> Opt.showDefault
-            )
-        <*> Opt.strOption
-            ( Opt.long "static-dir"
-                <> Opt.metavar "DIR"
-                <> Opt.help "Directory containing the SPA frontend static files"
-                <> Opt.value "frontend/dist"
-                <> Opt.showDefault
-            )
-        <*> Opt.strOption
-            ( Opt.long "db-path"
-                <> Opt.metavar "PATH"
-                <> Opt.help "Path to the SQLite database file"
-                <> Opt.value "data/sis.db"
-                <> Opt.showDefault
-            )
 
 main :: IO ()
 main = do
-    opts <-
+    let dbPath = "data/sis.db"
-        Opt.execParser $
+    createDirectoryIfMissing True (takeDirectory dbPath)
-            Opt.info (optionsParser Opt.<**> Opt.helper) $
-                Opt.fullDesc
-                    <> Opt.progDesc "Sis — shared household chore tracker"
-                    <> Opt.header "sis-server"
 
-    db <- Database.openDatabase (optDbPath opts)
+    putStrLn "[sis] opening database..."
+    conn <- openDatabase dbPath
 
-    _ <-
+    let port = 8080
-        Signals.installHandler
+    putStrLn $ "[sis] listening on 0.0.0.0:" <> show port
-            Signals.sigTERM
-            (Signals.Catch (putStrLn "[sis] shutting down"))
-            Nothing
 
-    let waiApp = Sis.app (optStaticDir opts) db
+    Warp.run port $
+        Static.staticPolicy (Static.addBase "frontend/static") $
+            liveAppWith
+                (ServerOptions
+                    { toDocument = document documentHead
+                    , serverError = defaultError
+                    , parseRequestBody = defaultParseRequestBodyOptions
+                    })
+                (runDB conn $ routeRequest router)
 
-    let settings =
+router :: (Hyperbole :> es, DB :> es) => AppRoute -> Eff es Response
-            Warp.setPort (optPort opts) $
+router RouteHome = do
-                Warp.setBeforeMainLoop
+    redirect (routeUri RouteDashboard)
-                    (putStrLn $ "[sis] listening on 0.0.0.0:" ++ show (optPort opts))
+router RouteLogin = runPage Sis.Page.Login.page
-                    Warp.defaultSettings
+router RouteSignup = runPage Sis.Page.Signup.page
-
+router RouteDashboard = runPage Sis.Page.Dashboard.page
-    Warp.runSettings settings waiApp
+router RouteChores = runPage Sis.Page.Chores.page
+router RouteHousehold = runPage Sis.Page.Household.page
+router RouteActivity = runPage Sis.Page.Activity.page

sis-server.cabal

@@ -19,7 +19,16 @@ library
       Sis
       Sis.Auth
       Sis.Database
+      Sis.Page.Activity
+      Sis.Page.Chores
+      Sis.Page.Dashboard
+      Sis.Page.Household
+      Sis.Page.Login
+      Sis.Page.Signup
+      Sis.Route
+      Sis.Style
       Sis.Types
+      Sis.View.Layout
   other-modules:
       Paths_sis_server
   autogen-modules:

src/Sis/Database.hs

@@ -1,23 +1,357 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
-{- | SQLite database support for Sis.
+{- | SQLite database support for Sis using the effectful effect system.
-
-Opens (and creates if missing) a SQLite database with WAL journal
-mode and foreign keys enabled. Runs schema migrations on startup.
 -}
-module Sis.Database (
+module Sis.Database
-    openDatabase,
+    ( -- * Effect
-    runMigrations,
+      DB (..)
-) where
+    , runDB
+    , openDatabase
+    , runMigrations
 
+      -- * DB operations (convenience wrappers)
+    , findUserByEmail
+    , createUser
+    , getUser
+    , getUserHouseholds
+    , getHousehold
+    , createHousehold
+    , getMembers
+    , getChores
+    , createChore
+    , updateChore
+    , deleteChore
+    , getDashboard
+    , recordActivity
+    , getActivityLog
+    , createInvite
+    , getInvites
+    , revokeInvite
+    , acceptInvite
+    , seed
+    ) where
+
+import Control.Monad (when)
+import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Time (Day, UTCTime, addDays, getCurrentTime, utctDay)
+import Data.Time qualified as Time
+import Data.Time.Calendar (addGregorianMonthsClip)
 import Database.SQLite.Simple qualified as SQL
+import Database.SQLite.Simple (Only (..))
+import Text.Read (readMaybe)
+import Effectful
+import Effectful.Dispatch.Dynamic
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (takeDirectory)
 
-{- | Open (or create) a SQLite database at the given path.
+import Sis.Types
 
-Enables WAL journal mode for concurrent read performance and
+----------------------------------------------------------------------
-enables foreign key enforcement.
+-- Effect definition
+----------------------------------------------------------------------
+
+data DB :: Effect where
+    FindUserByEmail :: Text -> DB m (Maybe User)
+    CreateUser :: Text -> Text -> Text -> DB m UserId
+    GetUser :: UserId -> DB m (Maybe User)
+    GetUserHouseholds :: UserId -> DB m [Household]
+    GetHousehold :: UserId -> Int -> DB m (Maybe Household)
+    CreateHousehold :: UserId -> Text -> DB m Household
+    GetMembers :: Int -> DB m [Membership]
+    GetChores :: Int -> DB m [Chore]
+    CreateChore :: Int -> Text -> ChoreAssignee -> Schedule -> Bool -> DB m Chore
+    UpdateChore :: Int -> Int -> Text -> ChoreAssignee -> Schedule -> Bool -> DB m Chore
+    DeleteChore :: Int -> DB m ()
+    GetDashboard :: Int -> Day -> DB m Dashboard
+    GenerateOccurrences :: Chore -> DB m ()
+    RecordActivity :: Int -> UserId -> ActivityStatus -> Maybe Text -> Bool -> DB m Activity
+    GetActivityLog :: Int -> Int -> Int -> DB m ActivityLogPage
+    CreateInvite :: Int -> Maybe Text -> DB m Invite
+    GetInvites :: Int -> DB m [Invite]
+    RevokeInvite :: Int -> DB m ()
+    AcceptInvite :: UserId -> Text -> DB m Household
+    Seed :: DB m ()
+
+type instance DispatchOf DB = 'Dynamic
+
+----------------------------------------------------------------------
+-- Handler
+----------------------------------------------------------------------
+
+runDB :: (IOE :> es) => SQL.Connection -> Eff (DB : es) a -> Eff es a
+runDB conn = interpret $ \_ -> \case
+    FindUserByEmail email -> liftIO $ do
+        result <- SQL.query conn
+            "SELECT id, display_name, email, password_hash FROM users WHERE email = ?"
+            (Only email)
+        pure $ listToMaybe [User (UserId uid) dname em pwHash | (uid, dname, em, pwHash) <- result]
+
+    CreateUser dname email pwHash -> liftIO $ do
+        SQL.execute conn
+            "INSERT INTO users (display_name, email, password_hash) VALUES (?, ?, ?)"
+            (dname, email, pwHash)
+        uid <- SQL.lastInsertRowId conn
+        pure $ UserId (fromIntegral uid)
+
+    GetUser (UserId uid) -> liftIO $ do
+        result <- SQL.query conn
+            "SELECT id, display_name, email, password_hash FROM users WHERE id = ?"
+            (Only uid)
+        pure $ listToMaybe [User (UserId uid') dname em pwHash | (uid', dname, em, pwHash) <- result]
+
+    GetUserHouseholds (UserId uid) -> liftIO $ do
+        rows <- SQL.query conn
+            "SELECT h.id, h.name, m2.user_id, \
+            \ (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
+            \ FROM households h JOIN memberships m ON m.household_id = h.id AND m.user_id = ? \
+            \ JOIN memberships m2 ON m2.household_id = h.id AND m2.role = 'owner'"
+            (Only uid)
+        pure [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- rows]
+
+    GetHousehold (UserId uid) hid -> liftIO $ do
+        result <- SQL.query conn
+            "SELECT h.id, h.name, m2.user_id, (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
+            \ FROM households h JOIN memberships m ON m.household_id = h.id AND m.user_id = ? \
+            \ JOIN memberships m2 ON m2.household_id = h.id AND m2.role = 'owner' WHERE h.id = ?"
+            (uid, hid)
+        pure $ listToMaybe [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- result]
+
+    CreateHousehold (UserId uid) name -> liftIO $ do
+        SQL.execute conn "INSERT INTO households (name) VALUES (?)" (Only name)
+        hId <- SQL.lastInsertRowId conn
+        let hid = HouseholdId (fromIntegral hId)
+        SQL.execute conn
+            "INSERT INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)"
+            (unHouseholdId hid, uid, "owner" :: String)
+        pure $ Household hid name (UserId uid) 1
+
+    GetMembers hid -> liftIO $ do
+        members <- SQL.query conn
+            "SELECT u.id, u.display_name, u.email, m.role \
+            \ FROM memberships m JOIN users u ON u.id = m.user_id WHERE m.household_id = ?"
+            (Only hid)
+        pure [Membership (UserId uid) dname email (if role == ("owner" :: String) then OwnerRole else MemberRole)
+             | (uid, dname, email, role) <- members]
+
+    GetChores hid -> liftIO $ do
+        chores <- SQL.query conn
+            "SELECT id, household_id, name, assignee_type, assignee_user_id, schedule_data, notify_on_due, created_at \
+            \ FROM chores WHERE household_id = ?"
+            (Only hid) :: IO [(Int, Int, Text, String, Maybe Int, Text, Int, UTCTime)]
+        pure [Chore { choreId = ChoreId cid
+                    , choreHouseholdId = HouseholdId hId
+                    , choreName = cname
+                    , choreAssignee = mkAssignee atype auid
+                    , choreSchedule = mkSchedule sData
+                    , choreNotifyOnDue = nud /= 0
+                    , choreCreatedAt = createdAt
+                    }
+             | (cid, hId, cname, atype, auid, sData, nud, createdAt) <- chores]
+      where
+        mkAssignee "user" (Just uid) = AssigneeUser (UserId uid)
+        mkAssignee _ _ = AssigneeAnyone
+        mkSchedule sData = fromMaybe ScheduleSometime (readMaybe (T.unpack sData))
+
+    CreateChore hid name assignee schedule notify -> liftIO $ do
+        now <- Time.getCurrentTime
+        let (aType, aUid) = case assignee of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
+            sType = case schedule of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
+            sData = show schedule
+        SQL.execute conn
+            "INSERT INTO chores (household_id, name, assignee_type, assignee_user_id, schedule_type, schedule_data, notify_on_due, created_at) \
+            \ VALUES (?,?,?,?,?,?,?,?)"
+            (hid, name, aType, aUid, sType, sData, if notify then 1 :: Int else 0, now)
+        cId <- SQL.lastInsertRowId conn
+        let chore = Chore (ChoreId (fromIntegral cId)) (HouseholdId hid) name assignee schedule notify now
+        generateOccurrencesIO conn chore
+        pure chore
+
+    UpdateChore cid hid name assignee schedule notify -> liftIO $ do
+        now <- Time.getCurrentTime
+        let (aType, aUid) = case assignee of AssigneeUser (UserId uid) -> ("user" :: String, Just uid); AssigneeAnyone -> ("anyone", Nothing)
+            sType = case schedule of ScheduleOneOff{} -> "one_off" :: String; ScheduleRecurring{} -> "recurring"; ScheduleSometime -> "sometime"
+            sData = show schedule
+        SQL.execute conn
+            "UPDATE chores SET name=?, assignee_type=?, assignee_user_id=?, schedule_type=?, schedule_data=?, notify_on_due=? WHERE id=? AND household_id=?"
+            (name, aType, aUid, sType, sData, if notify then 1 :: Int else 0, cid, hid)
+        SQL.execute conn "DELETE FROM occurrences WHERE chore_id = ? AND status IN ('due', 'overdue')" (Only cid)
+        let chore = Chore (ChoreId cid) (HouseholdId hid) name assignee schedule notify now
+        generateOccurrencesIO conn chore
+        pure chore
+
+    DeleteChore cid -> liftIO $ do
+        SQL.execute conn "DELETE FROM chores WHERE id = ?" (Only cid)
+
+    GetDashboard hid today -> liftIO $ do
+        let todayStr = show today
+        let weekAgo = show (addDays (-7) today)
+        [Only overdueCount] <- SQL.query conn
+            "SELECT COUNT(*) FROM occurrences o JOIN chores c ON c.id = o.chore_id \
+            \ WHERE c.household_id = ? AND o.due_date < ? AND o.status IN ('due', 'overdue')"
+            (hid, todayStr)
+        [Only dueTodayCount] <- SQL.query conn
+            "SELECT COUNT(*) FROM occurrences o JOIN chores c ON c.id = o.chore_id \
+            \ WHERE c.household_id = ? AND o.due_date = ? AND o.status = 'due'"
+            (hid, todayStr)
+        [Only doneThisWeek] <- SQL.query conn
+            "SELECT COUNT(*) FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id \
+            \ WHERE c.household_id = ? AND a.recorded_at >= ?"
+            (hid, weekAgo)
+        let stats = DashboardStats overdueCount dueTodayCount doneThisWeek
+        dueRows <- SQL.query conn
+            "SELECT o.id, o.chore_id, o.due_date, o.status, c.name, u.display_name \
+            \ FROM occurrences o JOIN chores c ON c.id = o.chore_id LEFT JOIN users u ON u.id = c.assignee_user_id \
+            \ WHERE c.household_id = ? AND o.due_date <= ? AND o.status IN ('due', 'overdue') ORDER BY o.due_date LIMIT 50"
+            (hid, todayStr) :: IO [(Int, Int, Day, Text, Text, Maybe Text)]
+        let dueItems = [DueItem (Occurrence (OccurrenceId oid) (ChoreId cid) d (mkOcc st)) cn uname (d < today) | (oid, cid, d, st, cn, uname) <- dueRows]
+        compRows <- SQL.query conn
+            "SELECT a.id, a.occurrence_id, a.user_id, a.status, a.note, a.notify_household, a.recorded_at, u.display_name, c.name \
+            \ FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id JOIN users u ON u.id = a.user_id \
+            \ WHERE c.household_id = ? AND a.recorded_at >= ? ORDER BY a.recorded_at DESC LIMIT 50"
+            (hid, show today) :: IO [(Int, Int, Int, Text, Maybe Text, Int, UTCTime, Text, Text)]
+        let compItems = [CompletedItem (Activity (ActivityId aid) (OccurrenceId oid) (UserId uid) (mkAct st) note (nh /= 0) recAt) uname cn | (aid, oid, uid, st, note, nh, recAt, uname, cn) <- compRows]
+        pure $ Dashboard stats dueItems compItems
+      where
+        mkOcc "due" = OccDue; mkOcc "overdue" = OccOverdue; mkOcc _ = OccCompleted
+        mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
+
+    GenerateOccurrences chore -> liftIO $ generateOccurrencesIO conn chore
+
+    RecordActivity oid (UserId uid) status note notify -> liftIO $ do
+        now <- Time.getCurrentTime
+        let actStatus = case status of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
+        SQL.execute conn
+            "INSERT INTO activities (occurrence_id, user_id, status, note, notify_household, recorded_at) VALUES (?,?,?,?,?,?)"
+            (oid, uid, actStatus, note, if notify then 1 :: Int else 0, now)
+        let occStatus = case status of ActivityCompleted -> "completed" :: String; ActivitySkipped -> "skipped"
+        SQL.execute conn "UPDATE occurrences SET status = ? WHERE id = ?" (occStatus, oid)
+        actId <- SQL.lastInsertRowId conn
+        pure $ Activity (ActivityId (fromIntegral actId)) (OccurrenceId oid) (UserId uid) status note notify now
+
+    GetActivityLog hid page perPage -> liftIO $ do
+        let offset = (page - 1) * perPage
+        [Only totalCount] <- SQL.query conn
+            "SELECT COUNT(*) FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id WHERE c.household_id = ?"
+            (Only hid)
+        entries <- SQL.query conn
+            "SELECT a.id, a.occurrence_id, a.user_id, a.status, a.note, a.notify_household, a.recorded_at, u.display_name, c.name, o.due_date \
+            \ FROM activities a JOIN occurrences o ON o.id = a.occurrence_id JOIN chores c ON c.id = o.chore_id JOIN users u ON u.id = a.user_id \
+            \ WHERE c.household_id = ? ORDER BY a.recorded_at DESC LIMIT ? OFFSET ?"
+            (hid, perPage, offset) :: IO [(Int, Int, Int, Text, Maybe Text, Int, UTCTime, Text, Text, Day)]
+        let logEntries = [ActivityLogEntry (Activity (ActivityId aid) (OccurrenceId oid) (UserId uid) (mkAct st) note (nh /= 0) recAt) uname "" cn d | (aid, oid, uid, st, note, nh, recAt, uname, cn, d) <- entries]
+        pure $ ActivityLogPage logEntries page perPage totalCount
+      where
+        mkAct "completed" = ActivityCompleted; mkAct _ = ActivitySkipped
+
+    CreateInvite hid email -> liftIO $ do
+        code <- generateTokenIO
+        now <- Time.getCurrentTime
+        SQL.execute conn
+            "INSERT INTO invites (household_id, code, email, created_at) VALUES (?, ?, ?, ?)"
+            (hid, code, email, now)
+        iid <- SQL.lastInsertRowId conn
+        pure $ Invite (InviteId (fromIntegral iid)) (HouseholdId hid) code email InvitePending now
+
+    GetInvites hid -> liftIO $ do
+        invites <- SQL.query conn
+            "SELECT id, household_id, code, email, status, created_at FROM invites WHERE household_id = ?"
+            (Only hid) :: IO [(Int, Int, Text, Maybe Text, Text, UTCTime)]
+        pure [Invite (InviteId iid) (HouseholdId hhid) code email (mkStatus st) createdAt | (iid, hhid, code, email, st, createdAt) <- invites]
+      where
+        mkStatus "pending" = InvitePending; mkStatus "accepted" = InviteAccepted; mkStatus _ = InviteRevoked
+
+    RevokeInvite iid -> liftIO $ do
+        SQL.execute conn "UPDATE invites SET status = 'revoked' WHERE id = ?" (Only iid)
+
+    AcceptInvite (UserId uid) code -> liftIO $ do
+        result <- SQL.query conn
+            "SELECT id, household_id FROM invites WHERE code = ? AND status = 'pending'"
+            (Only code) :: IO [(Int, Int)]
+        case result of
+            [(_, hid)] -> do
+                SQL.execute conn
+                    "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (?, ?, ?)"
+                    (hid, uid, "member" :: String)
+                SQL.execute conn "UPDATE invites SET status = 'accepted' WHERE code = ?" (Only code)
+                hResult <- SQL.query conn
+                    "SELECT h.id, h.name, m.user_id, (SELECT COUNT(*) FROM memberships WHERE household_id = h.id) \
+                    \ FROM households h JOIN memberships m ON m.household_id = h.id AND m.role = 'owner' WHERE h.id = ?"
+                    (Only hid) :: IO [(Int, Text, Int, Int)]
+                case listToMaybe [Household (HouseholdId hId) hName (UserId ownerId) count | (hId, hName, ownerId, count) <- hResult] of
+                    Just h -> pure h
+                    Nothing -> error "Household not found after accept"
+            _ -> error "Invite not found"
+
+    Seed -> liftIO $ do
+        let demoPassword = "password123"
+        pwHash <- hashPasswordIO demoPassword
+        SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (1, 'Alice', 'alice@demo.com', ?)" (Only pwHash)
+        SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (2, 'Bob', 'bob@demo.com', ?)" (Only pwHash)
+        SQL.execute conn "INSERT OR IGNORE INTO users (id, display_name, email, password_hash) VALUES (3, 'Charlie', 'charlie@demo.com', ?)" (Only pwHash)
+        SQL.execute_ conn "INSERT OR IGNORE INTO households (id, name) VALUES (1, 'Demo House')"
+        SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 1, 'owner')"
+        SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 2, 'member')"
+        SQL.execute_ conn "INSERT OR IGNORE INTO memberships (household_id, user_id, role) VALUES (1, 3, 'member')"
+        let sData1 = show (ScheduleRecurring PeriodDaily (read "2026-07-15") (Just "08:00:00") Nothing Nothing :: Schedule)
+        SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, schedule_type, schedule_data, notify_on_due) VALUES (1, 1, 'Take out trash', 'anyone', 'recurring', ?, 1)" (Only sData1)
+        let sData2 = show (ScheduleRecurring PeriodWeekly (read "2026-07-13") (Just "10:00:00") (Just [1, 4]) Nothing :: Schedule)
+        SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, assignee_user_id, schedule_type, schedule_data, notify_on_due) VALUES (2, 1, 'Vacuum living room', 'user', 2, 'recurring', ?, 0)" (Only sData2)
+        let sData3 = show (ScheduleSometime :: Schedule)
+        SQL.execute conn "INSERT OR IGNORE INTO chores (id, household_id, name, assignee_type, schedule_type, schedule_data, notify_on_due) VALUES (3, 1, 'Clean the garage', 'anyone', 'sometime', ?, 0)" (Only sData3)
+        today <- utctDay <$> getCurrentTime
+        let windowEnd = addDays 90 today
+        let dates1 = take 90 $ generateRecurringDates PeriodDaily (read "2026-07-15") today windowEnd
+        mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (1, ?)" . Only) dates1
+        let dates2 = take 90 $ generateRecurringDates PeriodWeekly (read "2026-07-13") today windowEnd
+        mapM_ (SQL.execute conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (2, ?)" . Only) dates2
+        SQL.execute_ conn "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (3, '9999-12-31')"
+
+----------------------------------------------------------------------
+-- Helpers
+----------------------------------------------------------------------
+
+generateOccurrencesIO :: SQL.Connection -> Chore -> IO ()
+generateOccurrencesIO conn' chore = do
+    today <- utctDay <$> getCurrentTime
+    let windowEnd = addDays 90 today
+    case choreSchedule chore of
+        ScheduleOneOff date _ ->
+            when (date >= today && date <= windowEnd) $
+                SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, ?)" (unChoreId (choreId chore), date)
+        ScheduleRecurring period startDate _ _ _ -> do
+            let dates = generateRecurringDates period startDate today windowEnd
+            mapM_ (\d -> SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, ?)" (unChoreId (choreId chore), d)) dates
+        ScheduleSometime ->
+            SQL.execute conn' "INSERT OR IGNORE INTO occurrences (chore_id, due_date) VALUES (?, '9999-12-31')" (Only (unChoreId (choreId chore)))
+
+generateRecurringDates :: SchedulePeriod -> Day -> Day -> Day -> [Day]
+generateRecurringDates period startDate fromDate toDate = go (max startDate fromDate)
+  where
+    go d | d > toDate = [] | otherwise = d : go (next period d)
+    next PeriodDaily = addDays 1; next PeriodWeekly = addDays 7; next PeriodMonthly = addGregorianMonthsClip 1
+
+hashPasswordIO :: Text -> IO Text
+hashPasswordIO password = do
+    -- Simple hashing stub — we'll use crypton via Auth.hs in the real implementation
+    pure password
+
+generateTokenIO :: IO Text
+generateTokenIO = do
+    -- Simple token stub
+    pure "dummy-token"
+
+----------------------------------------------------------------------
+-- Database open helper
+----------------------------------------------------------------------
+
+{- | Open (or create) a SQLite database at the given path.
 -}
 openDatabase :: FilePath -> IO SQL.Connection
 openDatabase path = do
@@ -30,9 +364,9 @@ openDatabase path = do
 
 -- | Create all tables if they don't exist.
 runMigrations :: SQL.Connection -> IO ()
-runMigrations conn =
+runMigrations conn' =
     mapM_
-        (SQL.execute_ conn)
+        (SQL.execute_ conn')
         [ "CREATE TABLE IF NOT EXISTS users (\
           \ id INTEGER PRIMARY KEY AUTOINCREMENT,\
           \ display_name TEXT NOT NULL,\
@@ -94,3 +428,64 @@ runMigrations conn =
           \ expires_at TEXT NOT NULL,\
           \ created_at TEXT NOT NULL DEFAULT (datetime('now')))"
         ]
+
+----------------------------------------------------------------------
+-- Convenience wrappers (send through the DB effect)
+----------------------------------------------------------------------
+
+findUserByEmail :: (DB :> es) => Text -> Eff es (Maybe User)
+findUserByEmail = send . FindUserByEmail
+
+createUser :: (DB :> es) => Text -> Text -> Text -> Eff es UserId
+createUser d e p = send (CreateUser d e p)
+
+getUser :: (DB :> es) => UserId -> Eff es (Maybe User)
+getUser = send . GetUser
+
+getUserHouseholds :: (DB :> es) => UserId -> Eff es [Household]
+getUserHouseholds = send . GetUserHouseholds
+
+getHousehold :: (DB :> es) => UserId -> Int -> Eff es (Maybe Household)
+getHousehold u = send . GetHousehold u
+
+createHousehold :: (DB :> es) => UserId -> Text -> Eff es Household
+createHousehold u = send . CreateHousehold u
+
+getMembers :: (DB :> es) => Int -> Eff es [Membership]
+getMembers = send . GetMembers
+
+getChores :: (DB :> es) => Int -> Eff es [Chore]
+getChores = send . GetChores
+
+createChore :: (DB :> es) => Int -> Text -> ChoreAssignee -> Schedule -> Bool -> Eff es Chore
+createChore h n a s b = send (CreateChore h n a s b)
+
+updateChore :: (DB :> es) => Int -> Int -> Text -> ChoreAssignee -> Schedule -> Bool -> Eff es Chore
+updateChore c h n a s b = send (UpdateChore c h n a s b)
+
+deleteChore :: (DB :> es) => Int -> Eff es ()
+deleteChore = send . DeleteChore
+
+getDashboard :: (DB :> es) => Int -> Day -> Eff es Dashboard
+getDashboard h = send . GetDashboard h
+
+recordActivity :: (DB :> es) => Int -> UserId -> ActivityStatus -> Maybe Text -> Bool -> Eff es Activity
+recordActivity o u s n b = send (RecordActivity o u s n b)
+
+getActivityLog :: (DB :> es) => Int -> Int -> Int -> Eff es ActivityLogPage
+getActivityLog h p pp = send (GetActivityLog h p pp)
+
+createInvite :: (DB :> es) => Int -> Maybe Text -> Eff es Invite
+createInvite h = send . CreateInvite h
+
+getInvites :: (DB :> es) => Int -> Eff es [Invite]
+getInvites = send . GetInvites
+
+revokeInvite :: (DB :> es) => Int -> Eff es ()
+revokeInvite = send . RevokeInvite
+
+acceptInvite :: (DB :> es) => UserId -> Text -> Eff es Household
+acceptInvite u = send . AcceptInvite u
+
+seed :: (DB :> es) => Eff es ()
+seed = send Seed

src/Sis/Page/Activity.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Activity (page) where
+
+import Data.Text (Text)
+import Effectful
+
+import Sis.Database
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.Page
+
+data ActivityPage = ActivityPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+
+instance (DB :> es) => HyperView ActivityPage es where
+    data Action ActivityPage
+        = RefreshActivity
+        | GoToPage Int
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+
+    update RefreshActivity = do
+        update (GoToPage 1)
+    update (GoToPage pageNum) = do
+        mUser <- lookupSession @UserSession
+        case mUser of
+            Nothing -> pure (el "Not authenticated")
+            Just us -> do
+                hhs <- getUserHouseholds (UserId (usUserId us))
+                case hhs of
+                    [] -> pure (el "No households")
+                    (h : _) -> do
+                        log <- getActivityLog (unHouseholdId (householdId h)) pageNum 20
+                        pure (activityView log)
+
+activityView :: ActivityLogPage -> View ActivityPage ()
+activityView log = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:960px;margin:0 auto" $ do
+        el @ att "class" nbFontHeading1Class $ text "Activity Log"
+        if null (alpEntries log)
+            then el @ att "style" "opacity:0.5" $ text "No activity recorded yet."
+            else el @ att "class" nbBoxClass $ mapM_ entryRow (alpEntries log)
+        if alpTotal log > alpPerPage log
+            then el @ att "style" "margin-top:1rem;display:flex;gap:0.5rem;justify-content:center" $ do
+                let totalPages = (alpTotal log + alpPerPage log - 1) `div` alpPerPage log
+                if alpPage log > 1
+                    then button (GoToPage (alpPage log - 1)) @ att "class" nbButtonClass $ text "Previous"
+                    else none
+                el @ att "style" "align-self:center" $
+                    text ("Page " <> show (alpPage log) <> " of " <> show totalPages)
+                if alpPage log < totalPages
+                    then button (GoToPage (alpPage log + 1)) @ att "class" nbButtonClass $ text "Next"
+                    else none
+            else none
+
+entryRow :: ActivityLogEntry -> View ActivityPage ()
+entryRow e = do
+    let act = aleActivity e
+        statusText = case activityStatus act of
+            ActivityCompleted -> "COMPLETED"
+            ActivitySkipped -> "SKIPPED"
+        statusColor = case activityStatus act of
+            ActivityCompleted -> colorGreen
+            ActivitySkipped -> "var(--nb-orange)"
+    el @ att "class" nbListItemClass @ att "style" "padding:0.5rem" $ do
+        el @ att "class" nbBadgeClass @ att "style" ("margin-right:0.5rem;background:" <> statusColor <> ";color:#000") $
+            text statusText
+        el @ att "style" "font-weight:500" $ text (aleUserName e)
+        text (" " <> statusText <> " ")
+        el @ att "style" "font-weight:500" $ text (aleChoreName e)
+        el @ att "style" "opacity:0.5" $
+            text ("on " <> show (aleOccurrenceDate e))
+        case activityNote act of
+            Just note ->
+                el @ att "style" "opacity:0.5;font-style:italic;margin-left:0.5rem" $
+                    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
+    case mSession of
+        Nothing -> do
+            redirect (routeUri RouteLogin)
+            pure (el "Redirecting...")
+        Just us -> do
+            hhs <- getUserHouseholds (UserId (usUserId us))
+            case hhs of
+                [] -> pure (el "No households")
+                (h : _) -> do
+                    log <- getActivityLog (unHouseholdId (householdId h)) 1 20
+                    pure (activityView log)

src/Sis/Page/Chores.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Chores (page) where
+
+import Data.Text (Text)
+import Data.Time (getCurrentTime)
+import Effectful
+
+import Sis.Database
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.Page
+
+data ChoresPage = ChoresPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+
+instance (DB :> es) => HyperView ChoresPage es where
+    data Action ChoresPage
+        = CRefreshChores
+        | CDeleteChore ChoreId
+        | CNewChore
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+
+    update CRefreshChores = do
+        mUser <- lookupSession @UserSession
+        case mUser of
+            Nothing -> pure (el "Not authenticated")
+            Just us -> do
+                hhs <- getUserHouseholds (UserId (usUserId us))
+                case hhs of
+                    [] -> pure (el "No households")
+                    (h : _) -> do
+                        chores' <- getChores (unHouseholdId (householdId h))
+                        pure (choresView chores')
+    update (CDeleteChore cid) = do
+        Sis.Database.DeleteChore (unChoreId cid)
+        update CRefreshChores
+    update CNewChore = do
+        -- TODO: show chore creation form
+        pure (el "New chore form coming soon")
+
+choresView :: [Chore] -> View ChoresPage ()
+choresView chores' = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:960px;margin:0 auto" $ do
+        el @ att "style" "display:flex;justify-content:space-between;align-items:center;margin-bottom:1rem" $ do
+            el @ att "class" nbFontHeading1Class $ text "Chores"
+            button CNewChore @ att "class" nbButtonClass $ text "+ New Chore"
+        if null chores'
+            then el @ att "style" "opacity:0.5" $ text "No chores yet. Create one to get started!"
+            else el @ att "class" nbBoxClass $ mapM_ choreRow chores'
+
+choreRow :: Chore -> View ChoresPage ()
+choreRow c = do
+    el @ att "class" nbListItemClass @ att "style" "display:flex;justify-content:space-between;align-items:center;padding:0.5rem" $ do
+        el @ att "style" "display:flex;gap:0.5rem;align-items:center" $ do
+            el @ att "class" nbBadgeClass $ text (scheduleBadge (choreSchedule c))
+            el @ att "style" "font-weight:500" $ text (choreName c)
+            el @ att "style" "opacity:0.5;font-size:0.85rem" $ text (scheduleLabel (choreSchedule c))
+        el @ att "style" "display:flex;gap:0.25rem" $ do
+            button CNewChore @ att "class" nbButtonClass @ att "style" "font-size:0.8rem;padding:0.25rem 0.5rem" $ text "Edit"
+            button (CDeleteChore (choreId c)) @ att "class" nbButtonClass @ att "style" "font-size:0.8rem;padding:0.25rem 0.5rem;background:var(--nb-red)" $ text "Delete"
+
+scheduleBadge :: Schedule -> Text
+scheduleBadge ScheduleSometime{} = "sometime"
+scheduleBadge ScheduleOneOff{} = "one-off"
+scheduleBadge ScheduleRecurring{} = "recurring"
+
+scheduleLabel :: Schedule -> Text
+scheduleLabel ScheduleSometime = "Sometime"
+scheduleLabel (ScheduleOneOff d _) = "One-off on " <> show d
+scheduleLabel (ScheduleRecurring p _ mt _ _) =
+    let pText = case p of PeriodDaily -> "daily"; PeriodWeekly -> "weekly"; PeriodMonthly -> "monthly"
+        timePart = maybe "" (\t -> " at " <> t) mt
+     in "Recurs " <> pText <> timePart
+
+page :: (Hyperbole :> es, DB :> es) => Eff es (View ChoresPage ())
+page = do
+    mSession <- lookupSession @UserSession
+    case mSession of
+        Nothing -> do
+            redirect (routeUri RouteLogin)
+            pure (el "Redirecting...")
+        Just us -> do
+            hhs <- getUserHouseholds (UserId (usUserId us))
+            case hhs of
+                [] -> pure (el "No households")
+                (h : _) -> do
+                    chores' <- getChores (unHouseholdId (householdId h))
+                    pure (choresView chores')

src/Sis/Page/Dashboard.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Dashboard (page) where
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Time (getCurrentTime, utctDay)
+import Effectful
+
+import Sis.Database
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.Page
+
+data DashboardPage = DashboardPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+
+instance (DB :> es) => HyperView DashboardPage es where
+    data Action DashboardPage
+        = RefreshDashboard
+        | CheckOff OccurrenceId
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+
+    update RefreshDashboard = do
+        mUser <- lookupSession @UserSession
+        case mUser of
+            Nothing -> pure (el "Not authenticated")
+            Just us -> do
+                today <- liftIO (utctDay <$> getCurrentTime)
+                hhs <- getUserHouseholds (UserId (usUserId us))
+                case hhs of
+                    [] -> pure (el "No households found")
+                    (h : _) -> do
+                        dash <- getDashboard (unHouseholdId (householdId h)) today
+                        pure (dashboardView dash)
+    update (CheckOff _oid) = do
+        -- TODO: wire up to activity form
+        update RefreshDashboard
+
+dashboardView :: Dashboard -> View DashboardPage ()
+dashboardView dash = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:960px;margin:0 auto" $ do
+        el @ att "class" nbFontHeading1Class $ text "Dashboard"
+        el @ att "style" "display:flex;gap:1rem;margin-bottom:1.5rem" $ do
+            let stats = dashStats dash
+            statTile "Overdue" (show (dsOverdue stats)) colorRed
+            statTile "Due Today" (show (dsDueToday stats)) colorYellow
+            statTile "Done This Week" (show (dsDoneThisWeek stats)) colorGreen
+        el @ att "class" nbFontHeading2Class $ text "Overdue & Due Today"
+        if null (dashDueItems dash)
+            then el @ att "style" "opacity:0.5" $ text "Nothing due! Great job."
+            else el @ att "class" nbBoxClass $ do
+                mapM_ dueItemRow (dashDueItems dash)
+        el @ att "class" nbFontHeading2Class $ text "Completed Today"
+        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"
+
+statTile :: Text -> Text -> Text -> View ctx ()
+statTile label count color = do
+    el @ att "class" nbBoxClass @ att "style" ("flex:1;text-align:center;padding:1rem;border-color:" <> color) $ do
+        el @ att "class" nbFontHeading1Class $ text count
+        text label
+
+dueItemRow :: DueItem -> View ctx ()
+dueItemRow di = do
+    el @ att "class" nbListItemClass @ att "style" "display:flex;justify-content:space-between;align-items:center;padding:0.5rem" $ do
+        el @ att "style" "display:flex;gap:0.5rem;align-items:center" $ do
+            let badgeColor = if diIsOverdue di then colorRed else colorYellow
+                badgeText = if diIsOverdue di then "OVERDUE" else "DUE"
+            el @ att "class" nbBadgeClass @ att "style" ("background:" <> badgeColor <> ";color:#000") $ text badgeText
+            text (diChoreName di)
+            case diAssigneeName di of
+                Just name -> el @ att "style" "opacity:0.5" $ text ("(" <> name <> ")")
+                Nothing -> none
+        button (CheckOff (occurrenceId (diOccurrence di))) @ att "class" nbButtonClass @ att "style" "font-size:0.85rem" $ text "Check Off"
+
+completedItemRow :: CompletedItem -> View ctx ()
+completedItemRow ci = do
+    el @ att "class" nbListItemClass @ att "style" "padding:0.5rem" $ do
+        let act = ciActivity ci
+            statusText = case activityStatus act of
+                ActivityCompleted -> "COMPLETED"
+                ActivitySkipped -> "SKIPPED"
+        el @ att "class" nbBadgeClass @ att "style" ("margin-right:0.5rem;background:" <> colorGreen <> ";color:#000") $ text statusText
+        text (ciUserName ci <> " " <> show (activityStatus act) <> " " <> ciChoreName ci)
+        case activityNote act of
+            Just note -> el @ att "style" "opacity:0.5;font-style:italic;margin-left:0.5rem" $ text ("— \"" <> note <> "\"")
+            Nothing -> none
+
+page :: (Hyperbole :> es, DB :> es) => Eff es (View DashboardPage ())
+page = do
+    mSession <- lookupSession @UserSession
+    case mSession of
+        Nothing -> do
+            redirect (routeUri RouteLogin)
+            pure (el "Redirecting...")
+        Just us -> do
+            today <- liftIO (utctDay <$> getCurrentTime)
+            hhs <- getUserHouseholds (UserId (usUserId us))
+            case hhs of
+                [] -> pure (el "No households — create one first")
+                (h : _) -> do
+                    dash <- getDashboard (unHouseholdId (householdId h)) today
+                    pure (dashboardView dash)

src/Sis/Page/Household.hs

@@ -0,0 +1,126 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Household (page) where
+
+import Data.Text (Text)
+import Data.Text qualified as T
+import Effectful
+
+import Sis.Database
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.Page
+
+data HouseholdPage = HouseholdPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+
+instance (DB :> es) => HyperView HouseholdPage es where
+    data Action HouseholdPage
+        = RefreshHousehold
+        | CreateInviteAction
+        | RevokeInviteAction InviteId
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+
+    update RefreshHousehold = do
+        mUser <- lookupSession @UserSession
+        case mUser of
+            Nothing -> pure (el "Not authenticated")
+            Just us -> do
+                hhs <- getUserHouseholds (UserId (usUserId us))
+                case hhs of
+                    [] -> pure (noHouseholdView)
+                    (h : _) -> do
+                        let hid = unHouseholdId (householdId h)
+                        mems <- getMembers hid
+                        invs <- getInvites hid
+                        pure (householdView h mems invs)
+    update CreateInviteAction = do
+        mUser <- lookupSession @UserSession
+        case mUser of
+            Nothing -> pure (el "Not authenticated")
+            Just us -> do
+                hhs <- getUserHouseholds (UserId (usUserId us))
+                case hhs of
+                    [] -> pure (el "No households")
+                    (h : _) -> do
+                        let hid = unHouseholdId (householdId h)
+                        _ <- createInvite hid Nothing
+                        update RefreshHousehold
+    update (RevokeInviteAction iid) = do
+        revokeInvite (unInviteId iid)
+        update RefreshHousehold
+
+noHouseholdView :: View HouseholdPage ()
+noHouseholdView = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto" $ do
+        el @ att "class" nbBoxClass @ att "style" "padding:2rem;text-align:center" $ do
+            el @ att "class" nbFontHeading1Class $ text "Create Your Household"
+            el @ att "style" "margin-bottom:1rem" $ text "You need a household to get started."
+            -- Form for household creation would go here
+            el $ text "Household creation form coming soon"
+
+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 "class" nbFontHeading2Class $ text "Members"
+        el @ att "class" nbBoxClass @ att "style" "margin-bottom:1.5rem" $ mapM_ memberRow mems
+        el @ att "class" nbFontHeading2Class $ text "Invite Members"
+        el @ att "class" nbBoxClass $ do
+            el @ att "style" "margin-bottom:0.5rem" $ text "Create an invite link to share:"
+            button CreateInviteAction @ att "class" nbButtonClass $ text "+ Create Invite Link"
+            if null invs
+                then none
+                else el @ att "style" "margin-top:1rem" $ do
+                    el @ att "class" nbFontHeading2Class $ text "Pending Invites"
+                    mapM_ inviteRow (filter ((== InvitePending) . inviteStatus) invs)
+
+memberRow :: Membership -> View HouseholdPage ()
+memberRow m = do
+    el @ att "class" nbListItemClass @ att "style" "display:flex;justify-content:space-between;align-items:center;padding:0.5rem" $ do
+        el @ att "style" "display:flex;gap:0.5rem;align-items:center" $ do
+            el @ att "class" nbBadgeClass @ att "style" "border-radius:50%;width:2rem;height:2rem;display:inline-flex;align-items:center;justify-content:center;font-size:0.8rem" $
+                text (initials (membershipDisplayName m))
+            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))
+
+inviteRow :: Invite -> View HouseholdPage ()
+inviteRow i = do
+    el @ att "class" nbListItemClass @ att "style" "display:flex;justify-content:space-between;padding:0.5rem" $ do
+        el @ att "style" "font-size:0.85rem" $ text ("/invite/" <> inviteCode i)
+        button (RevokeInviteAction (inviteId i)) @ att "class" nbButtonClass @ att "style" "font-size:0.8rem;background:var(--nb-red)" $
+            text "Revoke"
+
+initials :: Text -> Text
+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
+    case mSession of
+        Nothing -> do
+            redirect (routeUri RouteLogin)
+            pure (el "Redirecting...")
+        Just us -> do
+            hhs <- getUserHouseholds (UserId (usUserId us))
+            case hhs of
+                [] -> pure noHouseholdView
+                (h : _) -> do
+                    let hid = unHouseholdId (householdId h)
+                    mems <- getMembers hid
+                    invs <- getInvites hid
+                    pure (householdView h mems invs)

src/Sis/Page/Login.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Login (page) where
+import Effectful
+import Data.Text (Text)
+import Data.Text qualified as T
+import Sis.Database
+import Sis.Auth (hashPassword, verifyPassword, generateToken)
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.HyperView.Forms
+import Web.Hyperbole.Page
+data LoginPage = LoginPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+instance (DB :> es) => HyperView LoginPage es where
+    data Action LoginPage
+        = SubmitLogin
+        | Noop
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+    update SubmitLogin = do
+        formData' <- formData @LoginForm
+        mUser <- findUserByEmail (lfEmail formData')
+        case mUser of
+            Just u
+                | verifyPassword (lfPassword formData') (userPasswordHash u) -> do
+                    saveSession (UserSession (unUserId (userId u)))
+                    redirect (routeUri RouteDashboard)
+                    pure (el "Redirecting...")
+            _ -> pure (loginView (Just "Invalid email or password"))
+    update Noop = pure (loginView Nothing)
+loginView :: Maybe Text -> View LoginPage ()
+loginView mError = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto" $ do
+        el @ att "class" nbBoxClass @ att "style" "padding:2rem" $ do
+            el @ att "class" nbFontHeading1Class $ text "Welcome Back"
+            el @ att "style" "opacity:0.7;margin-bottom:1.5rem" $ text "Log in to manage your household chores."
+            case mError of
+                Just err ->
+                    el @ att "class" nbBoxClass @ att "style" ("border-color:" <> colorRed <> ";color:" <> colorRed <> ";padding:0.5rem;margin-bottom:1rem") $ text err
+                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%"
+                el @ att "class" nbLabelClass $ text "Password"
+                tag "input" @ att "type" "password" . att "name" "lfPassword" . att "class" nbInputClass @ att "style" "width:100%"
+                el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do
+                    tag "input" @ att "type" "checkbox" . att "name" "lfRemember"
+                    text "Remember me"
+                submit (text "Log In") @ att "class" nbButtonClass @ att "style" "width:100%"
+            route RouteSignup $ text "Don't have an account? Sign Up"
+page :: (Hyperbole :> es, DB :> es) => Eff es (View LoginPage ())
+page = do
+    mSession <- lookupSession @UserSession
+    case mSession of
+        Just _ -> do
+            redirect (routeUri RouteDashboard)
+            pure (el "Redirecting...")
+        Nothing -> pure (loginView Nothing)

src/Sis/Page/Signup.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE FlexibleContexts, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, TypeApplications, TypeOperators, OverloadedStrings #-}
+
+module Sis.Page.Signup (page) where
+import Effectful
+import Data.Text (Text)
+import Data.Text qualified as T
+import Sis.Database
+import Sis.Auth (hashPassword, verifyPassword, generateToken)
+import Sis.Route
+import Sis.Style
+import Sis.Types
+import Sis.View.Layout
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+import Web.Hyperbole.HyperView.Forms
+import Web.Hyperbole.Page
+data SignupPage = SignupPage
+    deriving stock (Generic)
+    deriving anyclass (ViewId)
+instance (DB :> es) => HyperView SignupPage es where
+    data Action SignupPage
+        = SubmitSignup
+        deriving stock (Generic)
+        deriving anyclass (ViewAction)
+    update SubmitSignup = do
+        form <- formData @SignupForm
+        if T.length (sfPassword form) < 8
+            then pure (signupView (Just "Password must be at least 8 characters"))
+            else
+                if sfPassword form /= sfConfirm form
+                    then pure (signupView (Just "Passwords do not match"))
+                    else do
+                        mExisting <- findUserByEmail (sfEmail form)
+                        case mExisting of
+                            Just _ -> pure (signupView (Just "Email already registered"))
+                            Nothing -> do
+                                pwHash <- liftIO (hashPassword (sfPassword form))
+                                uid <- createUser (sfDisplayName form) (sfEmail form) pwHash
+                                saveSession (UserSession (unUserId uid))
+                                redirect (routeUri RouteDashboard)
+                                pure (el "Redirecting...")
+signupView :: Maybe Text -> View SignupPage ()
+signupView mError = do
+    el @ att "class" nbContainerClass @ att "style" "max-width:480px;margin:4rem auto" $ do
+        el @ att "class" nbBoxClass @ att "style" "padding:2rem" $ do
+            el @ att "class" nbFontHeading1Class $ text "Create Account"
+            el @ att "style" "opacity:0.7;margin-bottom:1.5rem" $ text "Join your household chore tracker."
+            case mError of
+                Just err ->
+                    el @ att "class" nbBoxClass @ att "style" ("border-color:" <> colorRed <> ";color:" <> colorRed <> ";padding:0.5rem;margin-bottom:1rem") $ text err
+                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%"
+                el @ att "class" nbLabelClass $ text "Email"
+                tag "input" @ att "type" "email" . att "name" "sfEmail" . att "class" nbInputClass @ att "style" "width:100%"
+                el @ att "class" nbLabelClass $ text "Password (min 8 characters)"
+                tag "input" @ att "type" "password" . att "name" "sfPassword" . att "class" nbInputClass @ att "style" "width:100%"
+                el @ att "class" nbLabelClass $ text "Confirm Password"
+                tag "input" @ att "type" "password" . att "name" "sfConfirm" . att "class" nbInputClass @ att "style" "width:100%"
+                el @ att "style" "display:flex;align-items:center;gap:0.5rem;margin-bottom:1rem" $ do
+                    tag "input" @ att "type" "checkbox" . att "name" "sfAgree"
+                    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"
+page :: (Hyperbole :> es, DB :> es) => Eff es (View SignupPage ())
+page = do
+    mSession <- lookupSession @UserSession
+    case mSession of
+        Just _ -> do
+            redirect (routeUri RouteDashboard)
+            pure (el "Redirecting...")
+        Nothing -> pure (signupView Nothing)

src/Sis/Route.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Sis.Route (AppRoute (..)) where
+
+import GHC.Generics (Generic)
+import Web.Hyperbole.Route
+
+data AppRoute
+    = RouteHome
+    | RouteLogin
+    | RouteSignup
+    | RouteDashboard
+    | RouteChores
+    | RouteHousehold
+    | RouteActivity
+    deriving stock (Eq, Generic, Show)
+
+instance Route AppRoute where
+    baseRoute = Just RouteHome

src/Sis/Style.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Neo Brutalism CSS class name constants for Hyperbole views.
+-- Use with: \@ att \"class\" nbBoxClass
+module Sis.Style
+    ( nbBoxClass, nbButtonClass, nbInputClass, nbLabelClass
+    , nbBadgeClass, nbFontHeading1Class, nbFontHeading2Class
+    , nbNavbarClass, nbContainerClass, nbListItemClass
+    , colorRed, colorYellow, colorGreen
+    ) where
+
+import Data.Text (Text)
+
+nbBoxClass, nbButtonClass, nbInputClass, nbLabelClass, nbBadgeClass :: Text
+nbBoxClass = "nb-box"
+nbButtonClass = "nb-button"
+nbInputClass = "nb-input"
+nbLabelClass = "nb-label"
+nbBadgeClass = "nb-badge"
+
+nbFontHeading1Class, nbFontHeading2Class :: Text
+nbFontHeading1Class = "nb-font-heading1"
+nbFontHeading2Class = "nb-font-heading2"
+
+nbNavbarClass, nbContainerClass, nbListItemClass :: Text
+nbNavbarClass = "nb-navbar"
+nbContainerClass = "nb-container"
+nbListItemClass = "nb-list-item"
+
+colorRed, colorYellow, colorGreen :: Text
+colorRed = "var(--nb-red)"
+colorYellow = "var(--nb-yellow)"
+colorGreen = "var(--nb-green)"

src/Sis/Types.hs

@@ -56,6 +56,7 @@ module Sis.Types (
     HouseholdFormData (..),
 ) where
 
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Text (Text)
 import Data.Time (Day, LocalTime, UTCTime)
 import GHC.Generics (Generic)
@@ -66,22 +67,22 @@ import Web.Hyperbole.HyperView.Forms (FromForm)
 ----------------------------------------------------------------------
 
 newtype UserId = UserId {unUserId :: Int}
-    deriving newtype (Show, Eq, Read)
+    deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
 
 newtype HouseholdId = HouseholdId {unHouseholdId :: Int}
     deriving newtype (Show, Eq, Read)
 
 newtype ChoreId = ChoreId {unChoreId :: Int}
-    deriving newtype (Show, Eq, Read)
+    deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
 
 newtype OccurrenceId = OccurrenceId {unOccurrenceId :: Int}
-    deriving newtype (Show, Eq, Read)
+    deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
 
 newtype ActivityId = ActivityId {unActivityId :: Int}
-    deriving newtype (Show, Eq, Read)
+    deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
 
 newtype InviteId = InviteId {unInviteId :: Int}
-    deriving newtype (Show, Eq, Read)
+    deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
 
 ----------------------------------------------------------------------
 -- User

src/Sis/View/Layout.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+
+module Sis.View.Layout
+    ( documentHead
+    , navbar
+    , UserSession (..)
+    ) where
+
+import Data.Aeson
+import Data.Default
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+import Sis.Route
+import Sis.Style
+import Web.Hyperbole
+import Web.Hyperbole.Effect.Session
+
+----------------------------------------------------------------------
+-- Session
+----------------------------------------------------------------------
+
+data UserSession = UserSession
+    { usUserId :: Int
+    }
+    deriving stock (Show, Eq, Generic)
+    deriving anyclass (FromJSON, ToJSON)
+
+instance Session UserSession where
+    cookiePath = Just "/"
+
+instance Default UserSession where
+    def = UserSession 0
+
+----------------------------------------------------------------------
+-- Document Head
+----------------------------------------------------------------------
+
+documentHead :: View DocumentHead ()
+documentHead = do
+    title "Sis — Household Chore Tracker"
+    mobileFriendly
+    meta @ att "charset" "UTF-8"
+    stylesheet "https://unpkg.com/neobrutalismcss@latest"
+    stylesheet "/static/style.css"
+    tag "link" @ att "rel" "manifest" . att "href" "/static/manifest.json" $ none
+    script' scriptEmbed
+
+----------------------------------------------------------------------
+-- Navbar
+----------------------------------------------------------------------
+
+navbar :: View ctx ()
+navbar = do
+    el @ att "class" nbNavbarClass $ 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 :: (Route r) => r -> Text -> View ctx ()
+routeLink rt lbl = do
+    el @ att "class" nbButtonClass $ route rt $ text lbl