From 3b2cccf23e6cf8873c9fe3007bcc606093b5658b Mon Sep 17 00:00:00 2001
From: ambroslins <ambros.lins@gmail.com>
Date: Tue, 17 Oct 2023 22:40:50 +0200
Subject: [PATCH] Simplify `renderServer` for `ReaderT` and `ExceptT`

Hoisting the server monad does not requier IO.
---
 examples/mig-example-apps/Counter/Main.hs |  2 +-
 mig/src/Mig/Core/Class/Server.hs          | 18 +++++++-----------
 2 files changed, 8 insertions(+), 12 deletions(-)

diff --git a/examples/mig-example-apps/Counter/Main.hs b/examples/mig-example-apps/Counter/Main.hs
index bcc0793..bd5b951 100644
--- a/examples/mig-example-apps/Counter/Main.hs
+++ b/examples/mig-example-apps/Counter/Main.hs
@@ -21,7 +21,7 @@ main :: IO ()
 main = do
   env <- initEnv
   putStrLn ("The counter server listens on port: " <> show port)
-  runServer port . withSwagger def =<< (renderServer server env)
+  runServer port . withSwagger def $ renderServer server env
   where
     port = 8085
 
diff --git a/mig/src/Mig/Core/Class/Server.hs b/mig/src/Mig/Core/Class/Server.hs
index 28e8033..1a6ff50 100644
--- a/mig/src/Mig/Core/Class/Server.hs
+++ b/mig/src/Mig/Core/Class/Server.hs
@@ -8,7 +8,7 @@ module Mig.Core.Class.Server (
   fromReaderExcept,
 ) where
 
-import Control.Monad.Except
+import Control.Monad.Except (ExceptT, runExceptT)
 import Control.Monad.Reader
 import Data.Kind
 import Data.OpenApi (ToParamSchema, ToSchema)
@@ -111,18 +111,17 @@ instance HasServer IO where
   renderServer = id
 
 instance HasServer (ReaderT env IO) where
-  type ServerResult (ReaderT env IO) = env -> IO (Server IO)
+  type ServerResult (ReaderT env IO) = env -> Server IO
   renderServer server initEnv = fromReader initEnv server
 
 -- | Render reader server to IO-based server
-fromReader :: env -> Server (ReaderT env IO) -> IO (Server IO)
-fromReader env server =
-  flip runReaderT env $ ReaderT $ \e -> pure $ hoistServer (flip runReaderT e) server
+fromReader :: env -> Server (ReaderT env IO) -> Server IO
+fromReader env = hoistServer (flip runReaderT env)
 
 instance HasServer (ReaderT env (ExceptT Text IO)) where
   type
     ServerResult (ReaderT env (ExceptT Text IO)) =
-      env -> IO (Server IO)
+      env -> Server IO
 
   renderServer server initEnv = fromReaderExcept initEnv server
 
@@ -131,11 +130,8 @@ fromReaderExcept ::
   forall env.
   env ->
   Server (ReaderT env (ExceptT Text IO)) ->
-  IO (Server IO)
-fromReaderExcept env server =
-  flip runReaderT env $
-    ReaderT $
-      \e -> pure $ mapServerFun (handle e) server
+  Server IO
+fromReaderExcept env = mapServerFun (handle env)
   where
     handle :: env -> ServerFun (ReaderT env (ExceptT Text IO)) -> ServerFun IO
     handle e f = \req ->