diff --git a/cabal.project b/cabal.project index c6e53e56..dc1dc1e5 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,7 @@ packages: servant/ servant-client/ + servant-client-core/ servant-docs/ servant-foreign/ servant-server/ diff --git a/doc/tutorial/Server.lhs b/doc/tutorial/Server.lhs index e287a26b..5bd51534 100644 --- a/doc/tutorial/Server.lhs +++ b/doc/tutorial/Server.lhs @@ -18,6 +18,7 @@ need to have some language extensions and imports: {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} @@ -1057,75 +1058,71 @@ into something **servant** can understand? If we have a function that gets us from an `m a` to an `n a`, for any `a`, what do we have? -``` haskell ignore -newtype m :~> n = NT { ($$) :: forall a. m a -> n a} +``` haskell +type (~>) m n = forall a. m a -> n a ``` For example: ``` haskell -listToMaybeNT :: [] :~> Maybe -listToMaybeNT = NT listToMaybe -- from Data.Maybe +listToMaybe' :: [] ~> Maybe +listToMaybe' = listToMaybe -- from Data.Maybe ``` -(`NT` comes from "natural transformation", in case you're wondering.) +Note that `servant` doesn't declare the `~>` type-alias, as the unfolded +variant isn't much longer to write, as we'll see shortly. So if you want to write handlers using another monad/type than `Handler`, say the `Reader String` monad, the first thing you have to prepare is a function: ``` haskell ignore -readerToHandler :: Reader String :~> Handler +readerToHandler :: Reader String a -> Handler a ``` -Let's start with `readerToHandler'`. We obviously have to run the `Reader` -computation by supplying it with a `String`, like `"hi"`. We get an `a` out -from that and can then just `return` it into `Handler`. We can then just wrap -that function with the `NT` constructor to make it have the fancier type. +We obviously have to run the `Reader` computation by supplying it with a +`String`, like `"hi"`. We get an `a` out from that and can then just `return` +it into `Handler`. ``` haskell -readerToHandler' :: forall a. Reader String a -> Handler a -readerToHandler' r = return (runReader r "hi") - -readerToHandler :: Reader String :~> Handler -readerToHandler = NT readerToHandler' +readerToHandler :: Reader String a -> Handler a +readerToHandler r = return (runReader r "hi") ``` We can write some simple webservice with the handlers running in `Reader String`. ``` haskell type ReaderAPI = "a" :> Get '[JSON] Int - :<|> "b" :> Get '[JSON] String + :<|> "b" :> ReqBody '[JSON] Double :> Get '[JSON] Bool readerAPI :: Proxy ReaderAPI readerAPI = Proxy readerServerT :: ServerT ReaderAPI (Reader String) -readerServerT = a :<|> b +readerServerT = a :<|> b where + a :: Reader String Int + a = return 1797 - where a :: Reader String Int - a = return 1797 - - b :: Reader String String - b = ask + b :: Double -> Reader String Bool + b _ = asks (== "hi") ``` We unfortunately can't use `readerServerT` as an argument of `serve`, because `serve` wants a `Server ReaderAPI`, i.e., with handlers running in `Handler`. But there's a simple solution to this. -### Enter `enter` +### Welcome `hoistServer` That's right. We have just written `readerToHandler`, which is exactly what we would need to apply to all handlers to make the handlers have the right type for `serve`. Being cumbersome to do by hand, we provide a function -`enter` which takes a natural transformation between two parametrized types `m` +`hoistServer` which takes a natural transformation between two parametrized types `m` and `n` and a `ServerT someapi m`, and returns a `ServerT someapi n`. -In our case, we can wrap up our little webservice by using `enter -readerToHandler` on our handlers. +In our case, we can wrap up our little webservice by using +`hoistServer readerAPI readerToHandler` on our handlers. ``` haskell readerServer :: Server ReaderAPI -readerServer = enter readerToHandler readerServerT +readerServer = hoistServer readerAPI readerToHandler readerServerT app4 :: Application app4 = serve readerAPI readerServer @@ -1140,6 +1137,33 @@ $ curl http://localhost:8081/b "hi" ``` +### An arrow is a reader too. + +In previous versions of `servant` we had an `enter` to do what `hoistServer` +does now. `enter` had a ambitious design goals, but was problematic in practice. + +One problematic situation was when the source monad was `(->) r`, yet it's +handy in practice, because `(->) r` is isomorphic to `Reader r`. + +We can rewrite the previous example without `Reader`: + +```haskell +funServerT :: ServerT ReaderAPI ((->) String) +funServerT = a :<|> b where + a :: String -> Int + a _ = 1797 + + -- unfortunately, we cannot make `String` the first argument. + b :: Double -> String -> Bool + b _ s = s == "hi" + +funToHandler :: (String -> a) -> Handler a +funToHandler f = return (f "hi") + +app5 :: Application +app5 = serve readerAPI (hoistServer readerAPI funToHandler funServerT) +``` + ## Conclusion You're now equipped to write webservices/web-applications using diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 056ca28f..6cd61455 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -- | This module lets you implement 'Server's for defined APIs. You'll @@ -26,24 +27,10 @@ module Servant.Server , layout , layoutWithContext - -- * Enter - -- $enterDoc + -- * Enter / hoisting server + , hoistServer - -- ** Basic functions and datatypes - , enter - , (:~>)(..) - -- ** `Nat` utilities - , liftNat - , runReaderTNat - , evalStateTLNat - , evalStateTSNat - , logWriterTLNat - , logWriterTSNat -- ** Functions based on - , hoistNat - , embedNat - , squashNat - , generalizeNat , tweakResponse -- * Context @@ -106,12 +93,11 @@ module Servant.Server ) where -import Data.Proxy (Proxy) +import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged (..)) import Data.Text (Text) import Network.Wai (Application) import Servant.Server.Internal -import Servant.Utils.Enter -- * Implementing Servers @@ -145,6 +131,30 @@ serveWithContext :: (HasServer api context) serveWithContext p context server = toApplication (runRouter (route p context (emptyDelayed (Route server)))) +-- | Hoist server implementation. +-- +-- Sometimes our cherished `Handler` monad isn't quite the type you'd like for +-- your handlers. Maybe you want to thread some configuration in a @Reader@ +-- monad. Or have your types ensure that your handlers don't do any IO. Use +-- `hoistServer` (a successor of now deprecated @enter@). +-- +-- With `hoistServer`, you can provide a function, +-- to convert any number of endpoints from one type constructor to +-- another. For example +-- +-- /Note:/ 'Server' 'Raw' can also be entered. It will be retagged. +-- +-- >>> import Control.Monad.Reader +-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI +-- >>> let readerApi = Proxy :: Proxy ReaderAPI +-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String) +-- >>> let nt x = return (runReader x "hi") +-- >>> let mainServer = hoistServer readerApi nt readerServer :: Server ReaderAPI +-- +hoistServer :: (HasServer api '[]) => Proxy api + -> (forall x. m x -> n x) -> ServerT api m -> ServerT api n +hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[]) + -- | The function 'layout' produces a textual description of the internal -- router layout for debugging purposes. Note that the router layout is -- determined just by the API, not by the handlers. @@ -205,28 +215,6 @@ layoutWithContext :: (HasServer api context) layoutWithContext p context = routerLayout (route p context (emptyDelayed (FailFatal err501))) --- Documentation - --- $enterDoc --- Sometimes our cherished `ExceptT` monad isn't quite the type you'd like for --- your handlers. Maybe you want to thread some configuration in a @Reader@ --- monad. Or have your types ensure that your handlers don't do any IO. Enter --- `enter`. --- --- With `enter`, you can provide a function, wrapped in the `(:~>)` / `NT` --- newtype, to convert any number of endpoints from one type constructor to --- another. For example --- --- /Note:/ 'Server' 'Raw' can also be entered. It will be retagged. --- --- >>> import Control.Monad.Reader --- >>> import qualified Control.Category as C --- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI --- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String) --- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler --- >>> let mainServer = enter nt readerServer :: Server ReaderAPI --- - -- $setup -- >>> :set -XDataKinds -- >>> :set -XTypeOperators diff --git a/servant-server/src/Servant/Server/Experimental/Auth.hs b/servant-server/src/Servant/Server/Experimental/Auth.hs index 10713e35..17beff50 100644 --- a/servant-server/src/Servant/Server/Experimental/Auth.hs +++ b/servant-server/src/Servant/Server/Experimental/Auth.hs @@ -57,7 +57,7 @@ instance ( HasServer api context type ServerT (AuthProtect tag :> api) m = AuthServerData (AuthProtect tag) -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 6f10baa8..7dd290db 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -86,7 +86,7 @@ class HasServer api context where -> Delayed env (Server api) -> Router env - hoistServer + hoistServerWithContext :: Proxy api -> Proxy context -> (forall x. m x -> n x) @@ -118,9 +118,9 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont pb = Proxy :: Proxy b -- | This is better than 'enter', as it's tailor made for 'HasServer'. - hoistServer _ pc nt (a :<|> b) = - hoistServer (Proxy :: Proxy a) pc nt a :<|> - hoistServer (Proxy :: Proxy b) pc nt b + hoistServerWithContext _ pc nt (a :<|> b) = + hoistServerWithContext (Proxy :: Proxy a) pc nt a :<|> + hoistServerWithContext (Proxy :: Proxy b) pc nt b -- | If you use 'Capture' in one of the endpoints for your API, -- this automatically requires your server-side handler to be a function @@ -145,7 +145,7 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) type ServerT (Capture capture a :> api) m = a -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context d = CaptureRouter $ @@ -179,7 +179,7 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context) type ServerT (CaptureAll capture a :> api) m = [a] -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context d = CaptureAllRouter $ @@ -258,7 +258,7 @@ instance OVERLAPPABLE_ ) => HasServer (Verb method status ctypes a) context where type ServerT (Verb method status ctypes a) m = m a - hoistServer _ _ nt s = nt s + hoistServerWithContext _ _ nt s = nt s route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) @@ -270,7 +270,7 @@ instance OVERLAPPING_ ) => HasServer (Verb method status ctypes (Headers h a)) context where type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a) - hoistServer _ _ nt s = nt s + hoistServerWithContext _ _ nt s = nt s route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) @@ -302,7 +302,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context) type ServerT (Header sym a :> api) m = Maybe a -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addHeaderCheck` withRequest headerCheck @@ -347,7 +347,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context) type ServerT (QueryParam sym a :> api) m = Maybe a -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = let querytext req = parseQueryText $ rawQueryString req @@ -394,7 +394,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context) type ServerT (QueryParams sym a :> api) m = [a] -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = route (Proxy :: Proxy api) context $ subserver `addParameterCheck` withRequest paramsCheck @@ -436,7 +436,7 @@ instance (KnownSymbol sym, HasServer api context) type ServerT (QueryFlag sym :> api) m = Bool -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = let querytext r = parseQueryText $ rawQueryString r @@ -461,7 +461,7 @@ instance HasServer Raw context where type ServerT Raw m = Tagged m Application - hoistServer _ _ _ = retag + hoistServerWithContext _ _ _ = retag route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do -- note: a Raw application doesn't register any cleanup @@ -502,7 +502,7 @@ instance ( AllCTUnrender list a, HasServer api context type ServerT (ReqBody list a :> api) m = a -> ServerT api m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route Proxy context subserver = route (Proxy :: Proxy api) context $ @@ -538,14 +538,14 @@ instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) co (cs (symbolVal proxyPath)) (route (Proxy :: Proxy api) context subserver) where proxyPath = Proxy :: Proxy path - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s instance HasServer api context => HasServer (RemoteHost :> api) context where type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver remoteHost) - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s instance HasServer api context => HasServer (IsSecure :> api) context where type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m @@ -554,35 +554,35 @@ instance HasServer api context => HasServer (IsSecure :> api) context where route (Proxy :: Proxy api) context (passToServer subserver secure) where secure req = if isSecure req then Secure else NotSecure - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s instance HasServer api context => HasServer (Vault :> api) context where type ServerT (Vault :> api) m = Vault -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver vault) - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s instance HasServer api context => HasServer (HttpVersion :> api) context where type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver httpVersion) - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s -- | Ignore @'Summary'@ in server handlers. instance HasServer api ctx => HasServer (Summary desc :> api) ctx where type ServerT (Summary desc :> api) m = ServerT api m route _ = route (Proxy :: Proxy api) - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s -- | Ignore @'Description'@ in server handlers. instance HasServer api ctx => HasServer (Description desc :> api) ctx where type ServerT (Description desc :> api) m = ServerT api m route _ = route (Proxy :: Proxy api) - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s -- | Singleton type representing a server that serves an empty API. data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum) @@ -602,7 +602,7 @@ instance HasServer EmptyAPI context where route Proxy _ _ = StaticRouter mempty mempty - hoistServer _ _ _ = retag + hoistServerWithContext _ _ _ = retag -- | Basic Authentication instance ( KnownSymbol realm @@ -620,7 +620,7 @@ instance ( KnownSymbol realm basicAuthContext = getContextEntry context authCheck = withRequest $ \ req -> runBasicAuth req realm basicAuthContext - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s -- * helpers @@ -647,4 +647,4 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA subContext :: Context subContext subContext = descendIntoNamedContext (Proxy :: Proxy name) context - hoistServer _ _ nt s = hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s + hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s diff --git a/servant-server/test/Servant/ArbitraryMonadServerSpec.hs b/servant-server/test/Servant/ArbitraryMonadServerSpec.hs index 09ec30b8..cf07e710 100644 --- a/servant-server/test/Servant/ArbitraryMonadServerSpec.hs +++ b/servant-server/test/Servant/ArbitraryMonadServerSpec.hs @@ -3,9 +3,8 @@ {-# LANGUAGE TypeOperators #-} module Servant.ArbitraryMonadServerSpec where -import qualified Control.Category as C import Control.Monad.Reader -import Data.Functor.Identity +import Data.Functor.Identity import Data.Proxy import Servant.API import Servant.Server @@ -28,23 +27,26 @@ type CombinedAPI = ReaderAPI :<|> IdentityAPI readerAPI :: Proxy ReaderAPI readerAPI = Proxy +identityAPI :: Proxy IdentityAPI +identityAPI = Proxy + combinedAPI :: Proxy CombinedAPI combinedAPI = Proxy readerServer' :: ServerT ReaderAPI (Reader String) readerServer' = return 1797 :<|> ask -fReader :: Reader String :~> Handler -fReader = generalizeNat C.. (runReaderTNat "hi") +fReader :: Reader String a -> Handler a +fReader x = return (runReader x "hi") readerServer :: Server ReaderAPI -readerServer = enter fReader readerServer' +readerServer = hoistServer readerAPI fReader readerServer' combinedReaderServer' :: ServerT CombinedAPI (Reader String) -combinedReaderServer' = readerServer' :<|> enter (generalizeNat :: Identity :~> Reader String) (return True) +combinedReaderServer' = readerServer' :<|> hoistServer identityAPI (return . runIdentity) (return True) combinedReaderServer :: Server CombinedAPI -combinedReaderServer = enter fReader combinedReaderServer' +combinedReaderServer = hoistServer combinedAPI fReader combinedReaderServer' enterSpec :: Spec enterSpec = describe "Enter" $ do diff --git a/servant-server/test/Servant/HoistSpec.hs b/servant-server/test/Servant/HoistSpec.hs new file mode 100644 index 00000000..6b1570e3 --- /dev/null +++ b/servant-server/test/Servant/HoistSpec.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module Servant.HoistSpec where + +import Test.Hspec (Spec) + +import Servant + +------------------------------------------------------------------------------- +-- https://github.com/haskell-servant/servant/issues/734 +------------------------------------------------------------------------------- + +-- This didn't fail if executed in GHCi; cannot have as a doctest. + +newtype App a = App a + +type API = Get '[JSON] Int + :<|> ReqBody '[JSON] String :> Get '[JSON] Bool + +api :: Proxy API +api = Proxy + +server :: App Int :<|> (String -> App Bool) +server = undefined + +-- Natural transformation still seems to need an explicit type. +f :: App a -> App a +f = id + +server' :: App Int :<|> (String -> App Bool) +server' = hoistServer api f server + +------------------------------------------------------------------------------- +-- Spec +------------------------------------------------------------------------------- + +spec :: Spec +spec = return () diff --git a/servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs b/servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs index aad08b30..9c6afda2 100644 --- a/servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs +++ b/servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs @@ -89,7 +89,7 @@ data Res (sym :: Symbol) instance (KnownSymbol sym, HasServer api ctx) => HasServer (Res sym :> api) ctx where type ServerT (Res sym :> api) m = IORef (TestResource String) -> ServerT api m - hoistServer _ nc nt s = hoistServer (Proxy :: Proxy api) nc nt . s + hoistServerWithContext _ nc nt s = hoistServerWithContext (Proxy :: Proxy api) nc nt . s route Proxy ctx server = route (Proxy :: Proxy api) ctx $ addBodyCheck server (return ()) check diff --git a/servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs b/servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs index 65fb4577..75beebed 100644 --- a/servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs +++ b/servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs @@ -29,7 +29,7 @@ instance (HasContextEntry context String, HasServer subApi context) => type ServerT (ExtractFromContext :> subApi) m = String -> ServerT subApi m - hoistServer _ pc nt s = hoistServer (Proxy :: Proxy subApi) pc nt . s + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s route Proxy context delayed = route subProxy context (fmap inject delayed) @@ -47,8 +47,8 @@ instance (HasServer subApi (String ': context)) => type ServerT (InjectIntoContext :> subApi) m = ServerT subApi m - hoistServer _ _ nt s = - hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy (String ': context)) nt s + hoistServerWithContext _ _ nt s = + hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy (String ': context)) nt s route Proxy context delayed = route subProxy newContext delayed @@ -66,8 +66,8 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA type ServerT (NamedContextWithBirdface name subContext :> subApi) m = ServerT subApi m - hoistServer _ _ nt s = - hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s + hoistServerWithContext _ _ nt s = + hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s route Proxy context delayed = route subProxy subContext delayed diff --git a/servant/src/Servant/Utils/Enter.hs b/servant/src/Servant/Utils/Enter.hs index 27eae586..9fa1653a 100644 --- a/servant/src/Servant/Utils/Enter.hs +++ b/servant/src/Servant/Utils/Enter.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Servant.Utils.Enter ( +module Servant.Utils.Enter {-# DEPRECATED "Use hoistServer or hoistServerWithContext from servant-server" #-} ( module Servant.Utils.Enter, -- * natural-transformation re-exports (:~>)(..), diff --git a/servant/test/Servant/Utils/EnterSpec.hs b/servant/test/Servant/Utils/EnterSpec.hs index 0453f83a..324bac01 100644 --- a/servant/test/Servant/Utils/EnterSpec.hs +++ b/servant/test/Servant/Utils/EnterSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} module Servant.Utils.EnterSpec where import Test.Hspec (Spec)