runWarpServerSettings should not need Error ServantError

[Tristan de Cacqueray]

Or does it? Presently it seems like to run warp we need to add an extra runError, otherwise ghc throw this error:

    • Could not deduce (Error ServerError :> es)
        arising from a use of ‘runWarpServerSettings’

That should not be necessary after the servant hoisting. Can the es variable be divided into esWarp and esServant?

[Tristan de Cacqueray]

Looking at the servant-polysemy package, it seems like Error ServerError is not necessary for the outer effects: https://hackage.haskell.org/package/servant-polysemy-0.1.3/docs/Servant-Polysemy-Server.html#v:runWarpServer

runWarpServer :: forall api r. ( HasServer api '[], Member (Embed IO) r)
  => Warp.Port
  -> Bool
  -> ServerT api (Sem (Error ServerError ': r))
  -> Sem r ()

[Tristan de Cacqueray]

Using a similar definition for Eff, this seems to work as expected (e.g. runWarpServer users don't need to peel the ServerError effect, it is only required by the server implementation):

runWarpServerSettingsContext ::
  forall (api :: Type) (context :: [Type]) (es :: [E.Effect]).
  (HasServer api context, ServerContext context, IOE E.:> es) =>
  Warp.Settings ->
  Context context ->
  Servant.ServerT api (Eff (E.Error ServerError : es)) ->
  Wai.Middleware ->
  Eff es Void
runWarpServerSettingsContext settings cfg serverEff middleware = do
  unsafeEff $ \es ->
     Warp.runSettings settings (middleware $ hoistEff @api es cfg serverEff)
  error "Warp exited"

hoistEff ::
  forall (api :: Type) (context :: [Type]) (es :: [E.Effect]).
  (HasServer api context, ServerContext context) =>
  Effectful.Dispatch.Static.Primitive.Env es ->
  Context context ->
  Servant.ServerT api (Eff (E.Error ServerError : es)) ->
  Wai.Application
hoistEff env ctx serverEff = Servant.serveWithContextT (Proxy @api) ctx interpretServer serverEff
  where
    interpretServer :: Eff (E.Error ServerError : es) a -> Servant.Handler a
    interpretServer action = do
      v <- liftIO do
         es' <- Effectful.Dispatch.Static.Primitive.cloneEnv env
         unEff (E.runErrorNoCallStack action) es'
      T.liftEither v

I also used unsafeEff and cloneEnv to mitigate #6 , similarly to what @mmhat proposed in TristanCacqueray/ki-effectful#2 . The service seems to be running fine with this helper, but it would be great if you can confirm that is correct. If so, I would be happy to propose a similar change for the existing runWarpServer.

[Andrzej Rybczak]

@TristanCacqueray indeed your suggestion is correct 👍

[Tristan de Cacqueray]

@arybczak thank you for feedback, I proposed the change in #7 :)