jbrechtel
7eaf6ab7e7
- 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)
56 lines
1.7 KiB
Haskell
56 lines
1.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Main where
|
|
|
|
import Effectful
|
|
import Network.Wai.Handler.Warp qualified as Warp
|
|
import Network.Wai.Middleware.Static qualified as Static
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath (takeDirectory)
|
|
|
|
import Sis.Database
|
|
import Sis.Page.Activity
|
|
import Sis.Page.Chores
|
|
import Sis.Page.Dashboard
|
|
import Sis.Page.Household
|
|
import Sis.Page.Login
|
|
import Sis.Page.Signup
|
|
import Sis.Route
|
|
import Sis.View.Layout (documentHead)
|
|
import Web.Hyperbole
|
|
import Web.Hyperbole.Application
|
|
import Web.Hyperbole.Effect.Response
|
|
import Web.Hyperbole.Page
|
|
import Web.Hyperbole.Route
|
|
|
|
main :: IO ()
|
|
main = do
|
|
let dbPath = "data/sis.db"
|
|
createDirectoryIfMissing True (takeDirectory dbPath)
|
|
|
|
putStrLn "[sis] opening database..."
|
|
conn <- openDatabase dbPath
|
|
|
|
let port = 8080
|
|
putStrLn $ "[sis] listening on 0.0.0.0:" <> show port
|
|
|
|
Warp.run port $
|
|
Static.staticPolicy (Static.addBase "frontend/static") $
|
|
liveAppWith
|
|
(ServerOptions
|
|
{ toDocument = document documentHead
|
|
, serverError = defaultError
|
|
, parseRequestBody = defaultParseRequestBodyOptions
|
|
})
|
|
(runDB conn $ routeRequest router)
|
|
|
|
router :: (Hyperbole :> es, DB :> 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
|