HELPS/src/Main.hs

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