jbrechtel
a717d619d3
- All page modules now use proper Page es '[ViewId] type with hyper embedding - Fixed view DSL: tag calls, String/Text conversions, polymorphic context types - DB effect uses convenience wrappers (lowercase) with send - HyperView instances have DB :> es, IOE :> es constraints - Main.hs uses liveAppWith with proper router - Static file serving deferred (will use nginx or wai-app-static) - Warning suppressions added where needed - Build produces working 25MB sis-server binary
58 lines
1.8 KiB
Haskell
58 lines
1.8 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-}
|
|
|
|
module Main where
|
|
|
|
import Effectful
|
|
import Network.Wai.Application.Static qualified as Static
|
|
import Network.Wai.Handler.Warp qualified as Warp
|
|
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
|
|
|
|
let app = liveAppWith
|
|
(ServerOptions
|
|
{ toDocument = document documentHead
|
|
, serverError = defaultError
|
|
, parseRequestBody = defaultParseRequestBodyOptions
|
|
})
|
|
(runDB conn $ routeRequest router)
|
|
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
|