90 lines
2.3 KiB
Haskell
90 lines
2.3 KiB
Haskell
module Main (main) where
|
|
|
|
import Core
|
|
import Database
|
|
import Handlers
|
|
import Logger
|
|
import Routes
|
|
|
|
import Control.Monad.Except (ExceptT (ExceptT))
|
|
import Data.List
|
|
import Effectful
|
|
import Effectful.Error.Static (Error, runErrorNoCallStack, throwError)
|
|
import Effectful.Reader.Static
|
|
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
|
|
(envPort, envMode) <- do
|
|
port <- lookupEnv "PORT"
|
|
env <- lookupEnv "ENVIRONMENT"
|
|
pure (port, env)
|
|
|
|
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
|
|
:<|> userListHandler
|
|
:<|> userGetHandler
|
|
:<|> userPostHandler
|
|
:<|> userDeleteHandler
|
|
|
|
middleware :: Application -> Application
|
|
middleware = staticPolicy (noDots >-> addBase "data/assets/public")
|
|
|
|
--
|
|
-- Effect Stacks
|
|
--
|
|
|
|
appEff :: AppEnv -> AppEff a -> IO (Either ServerError a)
|
|
appEff env = runEff
|
|
. runErrorNoCallStack
|
|
. runReader env
|
|
. runDatabaseIO
|
|
. runLoggerPSQL
|
|
. inject
|
|
|
|
appDebug :: AppEnv -> AppEff a -> IO (Either ServerError a)
|
|
appDebug env = runEff
|
|
. runErrorNoCallStack
|
|
. runReader env
|
|
. runDatabaseDebug
|
|
. runLoggerConsole
|
|
. inject
|