solidabis-koodihaaste/src/Server.hs

{-# 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           Data.Language            (HasModel)
import           Solidabis.API            (HasClientEnv, HasToken)

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