jbrechtel
df9ad3d7c4
- Renamed route constructors: RouteLogin → RLogin, RouteDashboard → RDashboard, etc. - This fixes ambiguous occurrence errors with Types.Dashboard vs Route.Dashboard - Fixed Layout.hs navbar links to use new constructor names - Server verified serving HTML on /login, /rdashboard, etc.
58 lines
1.7 KiB
Haskell
58 lines
1.7 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 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
|