eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Update docs related to hoistServer

Browse source
This commit is contained in:
Oleg Grenrus 2017-10-01 19:20:09 +03:00
parent 4a6edd7864
commit 15cc4f55dd
11 changed files with 160 additions and 106 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cabal.project
View file

@ -1,6 +1,7 @@
packages:
servant/
servant-client/
servant-client-core/
servant-docs/
servant-foreign/
servant-server/

76
doc/tutorial/Server.lhs
View file

@ -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
where a :: Reader String Int
readerServerT = a :<|> b 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

68
servant-server/src/Servant/Server.hs
View file

@ -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 <https://hackage.haskell.org/package/mmorph mmorph>
, 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

2
servant-server/src/Servant/Server/Experimental/Auth.hs
View file

@ -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)

48
servant-server/src/Servant/Server/Internal.hs
View file

@ -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

14
servant-server/test/Servant/ArbitraryMonadServerSpec.hs
View file

@ -3,7 +3,6 @@
{-# LANGUAGE TypeOperators #-}
module Servant.ArbitraryMonadServerSpec where
import qualified Control.Category as C
import Control.Monad.Reader
import Data.Functor.Identity
import Data.Proxy
@ -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

38
servant-server/test/Servant/HoistSpec.hs Normal file
View file

@ -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 ()

2
servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs
View file

@ -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

10
servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs
View file

@ -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

2
servant/src/Servant/Utils/Enter.hs
View file

@ -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
(:~>)(..),

1
servant/test/Servant/Utils/EnterSpec.hs
View file

@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Servant.Utils.EnterSpec where
import Test.Hspec (Spec)