James/HELPS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reintroduce Debugging database handler; update main to allow for environment definition that will branch between all debug handlers or real effect handlers

Browse Source
This commit is contained in:
James Eversole
2024-11-05 15:18:21 -06:00
parent 13e8a11e83
commit 691e51660f
8 changed files with 137 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
src/Main.hs
View File

@@ -15,19 +15,48 @@ import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Static ((>->), staticPolicy, noDots, addBase)
import Servant hiding ((:>), throwError, inject)
import qualified Servant as S
import System.Environment (lookupEnv)
--
-- Types
--
data RunMode = Production | Debug
proxy :: Proxy AppAPI
proxy = Proxy
--
-- Application
--
main :: IO ()
main = do
pool <- createConnectionPool "host=localhost dbname=demo"
let env = AppEnv { pool = pool }
runAppEff env $ databaseInit
run port . middleware . serve proxy $ app env
(envPort, envMode) <- do
port <- lookupEnv "PORT"
env <- lookupEnv "ENVIRONMENT"
pure (port, env)
app :: AppEnv -> Server AppAPI
app env = hoistServer proxy (Handler . ExceptT . runAppEff env) handlers
let port = maybe 8080 read envPort
mode = case envMode of
Just "production" -> Production
_ -> Debug
env <- case mode of
Production -> do
dbPool <- createConnectionPool "host=localhost dbname=demo"
let env = AppEnv { pool = Just dbPool }
appEff env databaseInit
pure env
Debug -> do
let env = AppEnv { pool = Nothing }
appDebug env databaseInit
pure env
run port . middleware . serve proxy $ app env mode
app :: AppEnv -> RunMode -> Server AppAPI
app env Production = hoistServer proxy (Handler . ExceptT . appEff env) handlers
app env Debug = hoistServer proxy (Handler . ExceptT . appDebug env) handlers
handlers :: ServerT AppAPI AppEff
handlers = rootHandler
@@ -39,16 +68,22 @@ handlers = rootHandler
middleware :: Application -> Application
middleware = staticPolicy (noDots >-> addBase "data/assets/public")
runAppEff :: AppEnv -> AppEff a -> IO (Either ServerError a)
runAppEff env = runEff
--
-- Effect Stacks
--
appEff :: AppEnv -> AppEff a -> IO (Either ServerError a)
appEff env = runEff
. runErrorNoCallStack
. runReader env
. runDatabaseIO
. runLoggerPSQL
. inject
port :: Int
port = 8080
proxy :: Proxy AppAPI
proxy = Proxy
appDebug :: AppEnv -> AppEff a -> IO (Either ServerError a)
appDebug env = runEff
. runErrorNoCallStack
. runReader env
. runDatabaseDebug
. runLoggerConsole
. inject