{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module UnliftIO.Servant.Server
(
serve,
serveExceptT,
serveWithContext,
serveExceptTWithContext,
genericServe,
genericServeExceptT,
genericServeWithContext,
genericServeExceptTWithContext,
)
where
import Control.Monad ((>=>))
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.IO.Unlift (MonadUnliftIO (..), liftIO)
import Data.Proxy (Proxy)
import Servant.API.Generic (AsApi, GenericServant, ToServant, ToServantApi)
import Servant.Server
( Application,
Context,
HasServer,
ServerContext,
ServerT,
)
import qualified Servant.Server as Servant
import Servant.Server.Generic (AsServerT)
import qualified Servant.Server.Generic as Servant
serve ::
(MonadUnliftIO m, HasServer api '[]) =>
Proxy api ->
ServerT api m ->
m Application
serve :: forall (m :: * -> *) api.
(MonadUnliftIO m, HasServer api '[]) =>
Proxy api -> ServerT api m -> m Application
serve Proxy api
proxy = Proxy api -> Context '[] -> ServerT api m -> m Application
forall api (context :: [*]) (m :: * -> *).
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api -> Context context -> ServerT api m -> m Application
serveWithContext Proxy api
proxy Context '[]
Servant.EmptyContext
serveExceptT ::
(MonadUnliftIO m, HasServer api '[]) =>
Proxy api ->
(e -> Servant.ServerError) ->
ServerT api (ExceptT e m) ->
m Application
serveExceptT :: forall (m :: * -> *) api e.
(MonadUnliftIO m, HasServer api '[]) =>
Proxy api
-> (e -> ServerError) -> ServerT api (ExceptT e m) -> m Application
serveExceptT Proxy api
proxy e -> ServerError
toServerError =
Proxy api
-> (e -> ServerError)
-> Context '[]
-> ServerT api (ExceptT e m)
-> m Application
forall api (context :: [*]) (m :: * -> *) e.
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api
-> (e -> ServerError)
-> Context context
-> ServerT api (ExceptT e m)
-> m Application
serveExceptTWithContext Proxy api
proxy e -> ServerError
toServerError Context '[]
Servant.EmptyContext
serveWithContext ::
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api ->
Context context ->
ServerT api m ->
m Application
serveWithContext :: forall api (context :: [*]) (m :: * -> *).
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api -> Context context -> ServerT api m -> m Application
serveWithContext Proxy api
proxy Context context
context ServerT api m
api =
((forall a. m a -> IO a) -> IO Application) -> m Application
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$ Proxy api
-> Context context
-> (forall x. m x -> Handler x)
-> ServerT api m
-> Application
forall api (context :: [*]) (m :: * -> *).
(HasServer api context, ServerContext context) =>
Proxy api
-> Context context
-> (forall x. m x -> Handler x)
-> ServerT api m
-> Application
Servant.serveWithContextT Proxy api
proxy Context context
context (IO x -> Handler x
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> Handler x) -> (m x -> IO x) -> m x -> Handler x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> IO x
forall a. m a -> IO a
runInIO) ServerT api m
api
serveExceptTWithContext ::
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api ->
(e -> Servant.ServerError) ->
Context context ->
ServerT api (ExceptT e m) ->
m Application
serveExceptTWithContext :: forall api (context :: [*]) (m :: * -> *) e.
(HasServer api context, ServerContext context, MonadUnliftIO m) =>
Proxy api
-> (e -> ServerError)
-> Context context
-> ServerT api (ExceptT e m)
-> m Application
serveExceptTWithContext Proxy api
proxy e -> ServerError
toServerError Context context
context ServerT api (ExceptT e m)
api =
((forall a. m a -> IO a) -> IO Application) -> m Application
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$
Proxy api
-> Context context
-> (forall x. ExceptT e m x -> Handler x)
-> ServerT api (ExceptT e m)
-> Application
forall api (context :: [*]) (m :: * -> *).
(HasServer api context, ServerContext context) =>
Proxy api
-> Context context
-> (forall x. m x -> Handler x)
-> ServerT api m
-> Application
Servant.serveWithContextT
Proxy api
proxy
Context context
context
( IO (Either e x) -> Handler (Either e x)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e x) -> Handler (Either e x))
-> (ExceptT e m x -> IO (Either e x))
-> ExceptT e m x
-> Handler (Either e x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e x) -> IO (Either e x)
forall a. m a -> IO a
runInIO (m (Either e x) -> IO (Either e x))
-> (ExceptT e m x -> m (Either e x))
-> ExceptT e m x
-> IO (Either e x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m x -> m (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT e m x -> Handler (Either e x))
-> (Either e x -> Handler x) -> ExceptT e m x -> Handler x
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (e -> Handler x) -> (x -> Handler x) -> Either e x -> Handler x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ServerError -> Handler x
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> Handler x) -> (e -> ServerError) -> e -> Handler x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ServerError
toServerError) x -> Handler x
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
)
ServerT api (ExceptT e m)
api
genericServe ::
( GenericServant routes (AsServerT m),
GenericServant routes AsApi,
HasServer (ToServantApi routes) '[],
ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m),
MonadUnliftIO m
) =>
routes (AsServerT m) ->
m Application
genericServe :: forall (routes :: * -> *) (m :: * -> *).
(GenericServant routes (AsServerT m), GenericServant routes AsApi,
HasServer (ToServantApi routes) '[],
ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m),
MonadUnliftIO m) =>
routes (AsServerT m) -> m Application
genericServe routes (AsServerT m)
routes = ((forall a. m a -> IO a) -> IO Application) -> m Application
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> Handler a) -> routes (AsServerT m) -> Application
forall (routes :: * -> *) (m :: * -> *).
(GenericServant routes (AsServerT m), GenericServant routes AsApi,
HasServer (ToServantApi routes) '[],
ServerT (ToServantApi routes) m
~ ToServant routes (AsServerT m)) =>
(forall a. m a -> Handler a) -> routes (AsServerT m) -> Application
Servant.genericServeT (IO a -> Handler a
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Handler a) -> (m a -> IO a) -> m a -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IO a
forall a. m a -> IO a
runInIO) routes (AsServerT m)
routes
genericServeExceptT ::
( GenericServant routes (AsServerT (ExceptT e m)),
GenericServant routes AsApi,
HasServer (ToServantApi routes) '[],
ServerT (ToServantApi routes) (ExceptT e m)
~ ToServant routes (AsServerT (ExceptT e m)),
MonadUnliftIO m
) =>
(e -> Servant.ServerError) ->
routes (AsServerT (ExceptT e m)) ->
m Application
genericServeExceptT :: forall (routes :: * -> *) e (m :: * -> *).
(GenericServant routes (AsServerT (ExceptT e m)),
GenericServant routes AsApi, HasServer (ToServantApi routes) '[],
ServerT (ToServantApi routes) (ExceptT e m)
~ ToServant routes (AsServerT (ExceptT e m)),
MonadUnliftIO m) =>
(e -> ServerError)
-> routes (AsServerT (ExceptT e m)) -> m Application
genericServeExceptT e -> ServerError
toServerError routes (AsServerT (ExceptT e m))
routes =
(e -> ServerError)
-> routes (AsServerT (ExceptT e m)) -> Context '[] -> m Application
forall (routes :: * -> *) e (m :: * -> *) (context :: [*]).
(GenericServant routes (AsServerT (ExceptT e m)),
GenericServant routes AsApi,
HasServer (ToServantApi routes) context, ServerContext context,
ServerT (ToServantApi routes) (ExceptT e m)
~ ToServant routes (AsServerT (ExceptT e m)),
MonadUnliftIO m) =>
(e -> ServerError)
-> routes (AsServerT (ExceptT e m))
-> Context context
-> m Application
genericServeExceptTWithContext e -> ServerError
toServerError routes (AsServerT (ExceptT e m))
routes Context '[]
Servant.EmptyContext
genericServeWithContext ::
( GenericServant routes (AsServerT m),
GenericServant routes AsApi,
HasServer (ToServantApi routes) context,
ServerContext context,
ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m),
MonadUnliftIO m
) =>
routes (AsServerT m) ->
Context context ->
m Application
genericServeWithContext :: forall (routes :: * -> *) (m :: * -> *) (context :: [*]).
(GenericServant routes (AsServerT m), GenericServant routes AsApi,
HasServer (ToServantApi routes) context, ServerContext context,
ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m),
MonadUnliftIO m) =>
routes (AsServerT m) -> Context context -> m Application
genericServeWithContext routes (AsServerT m)
routes Context context
context = ((forall a. m a -> IO a) -> IO Application) -> m Application
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> Handler a)
-> routes (AsServerT m) -> Context context -> Application
forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).
(GenericServant routes (AsServerT m), GenericServant routes AsApi,
HasServer (ToServantApi routes) ctx,
HasContextEntry (ctx .++ '[ErrorFormatters]) ErrorFormatters,
ServerT (ToServantApi routes) m
~ ToServant routes (AsServerT m)) =>
(forall a. m a -> Handler a)
-> routes (AsServerT m) -> Context ctx -> Application
Servant.genericServeTWithContext (IO a -> Handler a
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Handler a) -> (m a -> IO a) -> m a -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IO a
forall a. m a -> IO a
runInIO) routes (AsServerT m)
routes Context context
context
genericServeExceptTWithContext ::
( GenericServant routes (AsServerT (ExceptT e m)),
GenericServant routes AsApi,
HasServer (ToServantApi routes) context,
ServerContext context,
ServerT (ToServantApi routes) (ExceptT e m)
~ ToServant routes (AsServerT (ExceptT e m)),
MonadUnliftIO m
) =>
(e -> Servant.ServerError) ->
routes (AsServerT (ExceptT e m)) ->
Context context ->
m Application
genericServeExceptTWithContext :: forall (routes :: * -> *) e (m :: * -> *) (context :: [*]).
(GenericServant routes (AsServerT (ExceptT e m)),
GenericServant routes AsApi,
HasServer (ToServantApi routes) context, ServerContext context,
ServerT (ToServantApi routes) (ExceptT e m)
~ ToServant routes (AsServerT (ExceptT e m)),
MonadUnliftIO m) =>
(e -> ServerError)
-> routes (AsServerT (ExceptT e m))
-> Context context
-> m Application
genericServeExceptTWithContext e -> ServerError
toServerError routes (AsServerT (ExceptT e m))
routes Context context
context =
((forall a. m a -> IO a) -> IO Application) -> m Application
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Application) -> m Application)
-> ((forall a. m a -> IO a) -> IO Application) -> m Application
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application -> IO Application) -> Application -> IO Application
forall a b. (a -> b) -> a -> b
$
(forall a. ExceptT e m a -> Handler a)
-> routes (AsServerT (ExceptT e m))
-> Context context
-> Application
forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).
(GenericServant routes (AsServerT m), GenericServant routes AsApi,
HasServer (ToServantApi routes) ctx,
HasContextEntry (ctx .++ '[ErrorFormatters]) ErrorFormatters,
ServerT (ToServantApi routes) m
~ ToServant routes (AsServerT m)) =>
(forall a. m a -> Handler a)
-> routes (AsServerT m) -> Context ctx -> Application
Servant.genericServeTWithContext
( IO (Either e a) -> Handler (Either e a)
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e a) -> Handler (Either e a))
-> (ExceptT e m a -> IO (Either e a))
-> ExceptT e m a
-> Handler (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e a) -> IO (Either e a)
forall a. m a -> IO a
runInIO (m (Either e a) -> IO (Either e a))
-> (ExceptT e m a -> m (Either e a))
-> ExceptT e m a
-> IO (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
(ExceptT e m a -> Handler (Either e a))
-> (Either e a -> Handler a) -> ExceptT e m a -> Handler a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (e -> Handler a) -> (a -> Handler a) -> Either e a -> Handler a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> Handler a) -> (e -> ServerError) -> e -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ServerError
toServerError) a -> Handler a
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
)
routes (AsServerT (ExceptT e m))
routes
Context context
context