{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Server.Generic (
AsServerT,
AsServer,
genericServe,
genericServeT,
genericServeTWithContext,
genericServer,
genericServerT,
) where
import Data.Proxy
(Proxy (..))
import Servant.API.Generic
import Servant.Server
data AsServerT (m :: * -> *)
instance GenericMode (AsServerT m) where
type AsServerT m :- api = ServerT api m
type AsServer = AsServerT Handler
genericServe
:: forall routes.
( HasServer (ToServantApi routes) '[]
, GenericServant routes AsServer
, Server (ToServantApi routes) ~ ToServant routes AsServer
)
=> routes AsServer -> Application
genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer
genericServeT
:: 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
genericServeT f server = serve p $ hoistServer p f (genericServerT server)
where
p = genericApi (Proxy :: Proxy routes)
genericServeTWithContext
:: forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).
( GenericServant routes (AsServerT m)
, GenericServant routes AsApi
, HasServer (ToServantApi routes) ctx
, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters
, ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)
)
=> (forall a. m a -> Handler a)
-> routes (AsServerT m)
-> Context ctx
-> Application
genericServeTWithContext f server ctx =
serveWithContext p ctx $
hoistServerWithContext p pctx f (genericServerT server)
where
p = genericApi (Proxy :: Proxy routes)
pctx = Proxy :: Proxy ctx
genericServer
:: GenericServant routes AsServer
=> routes AsServer
-> ToServant routes AsServer
genericServer = toServant
genericServerT
:: GenericServant routes (AsServerT m)
=> routes (AsServerT m)
-> ToServant routes (AsServerT m)
genericServerT = toServant