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)
This commit is contained in:
+43
-62
@@ -1,74 +1,55 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{- | Entry point for the Sis server.
|
||||
|
||||
Starts a Warp HTTP server, serves the JSON API and the SPA frontend.
|
||||
-}
|
||||
module Main (main) where
|
||||
module Main where
|
||||
|
||||
import Effectful
|
||||
import Network.Wai.Handler.Warp qualified as Warp
|
||||
import Options.Applicative qualified as Opt
|
||||
import System.Posix.Signals qualified as Signals
|
||||
import Network.Wai.Middleware.Static qualified as Static
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
import System.FilePath (takeDirectory)
|
||||
|
||||
import Sis.Database qualified as Database
|
||||
import Sis.Server qualified as Sis
|
||||
|
||||
data Options = Options
|
||||
{ optPort :: Int
|
||||
, optStaticDir :: FilePath
|
||||
, optDbPath :: FilePath
|
||||
}
|
||||
|
||||
optionsParser :: Opt.Parser Options
|
||||
optionsParser =
|
||||
Options
|
||||
<$> Opt.option
|
||||
Opt.auto
|
||||
( 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
|
||||
)
|
||||
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
|
||||
opts <-
|
||||
Opt.execParser $
|
||||
Opt.info (optionsParser Opt.<**> Opt.helper) $
|
||||
Opt.fullDesc
|
||||
<> Opt.progDesc "Sis — shared household chore tracker"
|
||||
<> Opt.header "sis-server"
|
||||
let dbPath = "data/sis.db"
|
||||
createDirectoryIfMissing True (takeDirectory dbPath)
|
||||
|
||||
db <- Database.openDatabase (optDbPath opts)
|
||||
putStrLn "[sis] opening database..."
|
||||
conn <- openDatabase dbPath
|
||||
|
||||
_ <-
|
||||
Signals.installHandler
|
||||
Signals.sigTERM
|
||||
(Signals.Catch (putStrLn "[sis] shutting down"))
|
||||
Nothing
|
||||
let port = 8080
|
||||
putStrLn $ "[sis] listening on 0.0.0.0:" <> show port
|
||||
|
||||
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 =
|
||||
Warp.setPort (optPort opts) $
|
||||
Warp.setBeforeMainLoop
|
||||
(putStrLn $ "[sis] listening on 0.0.0.0:" ++ show (optPort opts))
|
||||
Warp.defaultSettings
|
||||
|
||||
Warp.runSettings settings waiApp
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user