34 lines
1020 B
Haskell
34 lines
1020 B
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
module Server where
|
|
|
|
import Control.Monad.Reader (MonadReader, ask, asks, runReaderT)
|
|
import Control.Monad.Trans (MonadIO, liftIO)
|
|
import Data.Aeson (FromJSON)
|
|
import Network.Wai.Handler.Warp (run)
|
|
import Servant
|
|
import Servant.Server.Generic
|
|
|
|
import API (handler)
|
|
import Solidabis.API (HasClientEnv, HasToken)
|
|
import Data.Language (HasModel)
|
|
|
|
newtype Port = Port Int deriving (Show, FromJSON)
|
|
|
|
class HasPort a where
|
|
getPort :: a -> Port
|
|
setPort :: a -> Port -> a
|
|
|
|
instance HasPort Port where
|
|
getPort = id
|
|
setPort = const
|
|
|
|
app :: (HasModel r, HasClientEnv r, HasToken r) => r -> Application
|
|
app env = genericServeT (`runReaderT` env) API.handler
|
|
|
|
server
|
|
:: (HasModel r, HasClientEnv r, HasToken r, HasPort r, MonadReader r m, MonadIO m)
|
|
=> m ()
|
|
server = do
|
|
Port port <- asks getPort
|
|
ask >>= liftIO . run port . app
|