Generic.hs

module Effectful.Servant.Server.Generic
    ( module Effectful.Servant.Server.Generic
    , module Servant.Server.Generic
    )
where

import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Effectful
import Effectful.Servant.API
import Effectful.Servant.Server
import Effectful.Wai (Application)
import Servant
    ( DefaultErrorFormatters
    , ErrorFormatters
    , hoistServer
    )
import Servant.Server.Generic (AsServerT, genericServerT)
import Servant.Server.Generic qualified as Servant
import Prelude

type AsServer (es :: [Effect]) = AsServerT (Handler es)

-- | Lifted 'Servant.genericServe'.
genericServe
    :: forall (routes :: Type -> Type) (es :: [Effect])
     . ( HasServer (ToServantApi routes) '[]
       , GenericServant routes (AsServer es)
       , Server (ToServantApi routes) es ~ ToServant routes (AsServer es)
       , IOE :> es
       )
    => routes (AsServer es) -> Application es
genericServe = serve @(ToServantApi routes) Proxy . genericServer

-- | Lifted 'Servant.genericServeT'.
genericServeT
    :: forall (routes :: Type -> Type) (m :: Type -> Type) (es :: [Effect])
     . ( GenericServant routes (AsServerT m)
       , HasServer (ToServantApi routes) '[]
       , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)
       , IOE :> es
       )
    => (forall a. m a -> Handler es a)
    -- ^ 'hoistServer' argument to come back to 'Handler'
    -> routes (AsServerT m)
    -- ^ your record full of request handlers
    -> Application es
genericServeT f server = serve p $ hoistServer p f (Servant.genericServerT server)
  where
    p = Proxy @(ToServantApi routes)

-- | Lifted 'Servant.genericServeTWithContext'.
genericServeTWithContext
    :: forall (routes :: Type -> Type) (m :: Type -> Type) (ctx :: [Type]) (es :: [Effect])
     . ( GenericServant routes (AsServerT m)
       , HasServer (ToServantApi routes) ctx
       , HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters
       , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)
       , IOE :> es
       )
    => (forall a. m a -> Handler es 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 es
genericServeTWithContext f server ctx =
    serveWithContext p ctx $
        hoistServerWithContext p pctx f (Servant.genericServerT server)
  where
    p = Proxy @(ToServantApi routes)
    pctx = Proxy @ctx

-- | Lifted 'Servant.genericServer'.
genericServer
    :: (GenericServant routes (AsServer es))
    => routes (AsServer es)
    -> ToServant routes (AsServer es)
genericServer = toServant