{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
-- | @since 0.14.1
module Servant.Server.Generic (
    AsServerT,
    AsServer,
    genericServe,
    genericServeT,
    genericServeTWithContext,
    genericServer,
    genericServerT,
  ) where

import           Data.Proxy
                 (Proxy (..))

import           Servant.API.Generic
import           Servant.Server

-- | A type that specifies that an API record contains a server implementation.
data AsServerT (m :: * -> *)
instance GenericMode (AsServerT m) where
    type AsServerT m :- api = ServerT api m

type AsServer = AsServerT Handler

-- | Transform a record of routes into a WAI 'Application'.
genericServe
    :: forall routes.
       ( HasServer (ToServantApi routes) '[]
       , GenericServant routes AsServer
       , Server (ToServantApi routes) ~ ToServant routes AsServer
       )
    => routes AsServer -> Application
genericServe :: routes AsServer -> Application
genericServe = Proxy (GToServant (Rep (routes AsApi)))
-> Server (GToServant (Rep (routes AsApi))) -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy (GToServant (Rep (routes AsApi)))
forall k (t :: k). Proxy t
Proxy :: Proxy (ToServantApi routes))  (GToServant (Rep (routes AsServer)) -> Application)
-> (routes AsServer -> GToServant (Rep (routes AsServer)))
-> routes AsServer
-> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. routes AsServer -> GToServant (Rep (routes AsServer))
forall (routes :: * -> *).
GenericServant routes AsServer =>
routes AsServer -> ToServant routes AsServer
genericServer

-- | Transform a record of routes with custom monad into a WAI 'Application',
--   by providing a transformation to bring each handler back in the 'Handler'
--   monad.
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) -- ^ 'hoistServer' argument to come back to 'Handler'
  -> routes (AsServerT m)         -- ^ your record full of request handlers
  -> Application
genericServeT :: (forall a. m a -> Handler a) -> routes (AsServerT m) -> Application
genericServeT forall a. m a -> Handler a
f routes (AsServerT m)
server = Proxy (GToServant (Rep (routes AsApi)))
-> Server (GToServant (Rep (routes AsApi))) -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy (GToServant (Rep (routes AsApi)))
p (Server (GToServant (Rep (routes AsApi))) -> Application)
-> Server (GToServant (Rep (routes AsApi))) -> Application
forall a b. (a -> b) -> a -> b
$ Proxy (GToServant (Rep (routes AsApi)))
-> (forall a. m a -> Handler a)
-> ServerT (GToServant (Rep (routes AsApi))) m
-> Server (GToServant (Rep (routes AsApi)))
forall api (m :: * -> *) (n :: * -> *).
HasServer api '[] =>
Proxy api
-> (forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServer Proxy (GToServant (Rep (routes AsApi)))
p forall a. m a -> Handler a
f (routes (AsServerT m) -> ToServant routes (AsServerT m)
forall (routes :: * -> *) (m :: * -> *).
GenericServant routes (AsServerT m) =>
routes (AsServerT m) -> ToServant routes (AsServerT m)
genericServerT routes (AsServerT m)
server)
  where
    p :: Proxy (GToServant (Rep (routes AsApi)))
p = Proxy routes -> Proxy (GToServant (Rep (routes AsApi)))
forall (routes :: * -> *).
GenericServant routes AsApi =>
Proxy routes -> Proxy (ToServantApi routes)
genericApi (Proxy routes
forall k (t :: k). Proxy t
Proxy :: Proxy routes)

-- | Transform a record of routes with custom monad into a WAI 'Application',
--   while using the given 'Context' to serve the application (contexts are typically
--   used by auth-related combinators in servant, e.g to hold auth checks) and the given
--   transformation to map all the handlers back to the 'Handler' monad.
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) -- ^ 'hoistServer' argument to come back to 'Handler'
  -> routes (AsServerT m)         -- ^ your record full of request handlers
  -> Context ctx                  -- ^ the 'Context' to serve the application with
  -> Application
genericServeTWithContext :: (forall a. m a -> Handler a)
-> routes (AsServerT m) -> Context ctx -> Application
genericServeTWithContext forall a. m a -> Handler a
f routes (AsServerT m)
server Context ctx
ctx =
  Proxy (GToServant (Rep (routes AsApi)))
-> Context ctx
-> Server (GToServant (Rep (routes AsApi)))
-> Application
forall api (context :: [*]).
(HasServer api context,
 HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters) =>
Proxy api -> Context context -> Server api -> Application
serveWithContext Proxy (GToServant (Rep (routes AsApi)))
p Context ctx
ctx (Server (GToServant (Rep (routes AsApi))) -> Application)
-> Server (GToServant (Rep (routes AsApi))) -> Application
forall a b. (a -> b) -> a -> b
$
  Proxy (GToServant (Rep (routes AsApi)))
-> Proxy ctx
-> (forall a. m a -> Handler a)
-> ServerT (GToServant (Rep (routes AsApi))) m
-> Server (GToServant (Rep (routes AsApi)))
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext Proxy (GToServant (Rep (routes AsApi)))
p Proxy ctx
pctx forall a. m a -> Handler a
f (routes (AsServerT m) -> ToServant routes (AsServerT m)
forall (routes :: * -> *) (m :: * -> *).
GenericServant routes (AsServerT m) =>
routes (AsServerT m) -> ToServant routes (AsServerT m)
genericServerT routes (AsServerT m)
server)
  where
    p :: Proxy (GToServant (Rep (routes AsApi)))
p = Proxy routes -> Proxy (GToServant (Rep (routes AsApi)))
forall (routes :: * -> *).
GenericServant routes AsApi =>
Proxy routes -> Proxy (ToServantApi routes)
genericApi (Proxy routes
forall k (t :: k). Proxy t
Proxy :: Proxy routes)
    pctx :: Proxy ctx
pctx = Proxy ctx
forall k (t :: k). Proxy t
Proxy :: Proxy ctx

-- | Transform a record of endpoints into a 'Server'.
genericServer
    :: GenericServant routes AsServer
    => routes AsServer
    -> ToServant routes AsServer
genericServer :: routes AsServer -> ToServant routes AsServer
genericServer = routes AsServer -> ToServant routes AsServer
forall (routes :: * -> *) mode.
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant

-- | Transform a record of endpoints into a @'ServerT' m@.
--
--  You can see an example usage of this function
--  <https://docs.servant.dev/en/stable/cookbook/generic/Generic.html#using-generics-together-with-a-custom-monad in the Servant Cookbook>.
genericServerT
    :: GenericServant routes (AsServerT m)
    => routes (AsServerT m)
    -> ToServant routes (AsServerT m)
genericServerT :: routes (AsServerT m) -> ToServant routes (AsServerT m)
genericServerT = routes (AsServerT m) -> ToServant routes (AsServerT m)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
routes mode -> ToServant routes mode
toServant