15cc4f5 · typeable/servant

git.iko.soy/typeable/servant

Update docs related to hoistServer

commit15cc4f55dd575f425b92dae71825a37d53254aad authorOleg Grenrus <oleg.grenrus@iki.fi> dateSun 1 Oct 2017, 19:20 (9 years ago) parent4a6edd7

11 files changed+161−107

compare with master

unifiedsplit

cabal.project+1 doc/tutorial/Server.lhs+51−27 servant-server/src/Servant/Server.hs+29−41 servant-server/src/Servant/Server/Experimental/Auth.hs+1−1 servant-server/src/Servant/Server/Internal.hs+24−24 servant-server/test/Servant/ArbitraryMonadServerSpec.hs+9−7 servant-server/test/Servant/HoistSpec.hs+38 servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs+1−1 servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs+5−5 servant/src/Servant/Utils/Enter.hs+1−1 servant/test/Servant/Utils/EnterSpec.hs+1

cabal.project+1

@@ -1,6 +1,7 @@

11packages:

22 servant/

33 servant-client/

4+ servant-client-core/

45 servant-docs/

56 servant-foreign/

67 servant-server/

doc/tutorial/Server.lhs+51−27

@@ -18,6 +18,7 @@ need to have some language extensions and imports:

1818{-# LANGUAGE GeneralizedNewtypeDeriving #-}

1919{-# LANGUAGE MultiParamTypeClasses #-}

2020{-# LANGUAGE OverloadedStrings #-}

21+{-# LANGUAGE RankNTypes #-}

2122{-# LANGUAGE ScopedTypeVariables #-}

2223{-# LANGUAGE TypeOperators #-}

2324

@@ -1057,75 +1058,71 @@ into something **servant** can understand?

10571058If we have a function that gets us from an `m a` to an `n a`, for any `a`, what

10581059do we have?

10591060

1060−``` haskell ignore

1061−newtype m :~> n = NT { ($$) :: forall a. m a -> n a}

1061+``` haskell

1062+type (~>) m n = forall a. m a -> n a

10621063```

10631064

10641065For example:

10651066

10661067``` haskell

1067−listToMaybeNT :: [] :~> Maybe

1068−listToMaybeNT = NT listToMaybe -- from Data.Maybe

1068+listToMaybe' :: [] ~> Maybe

1069+listToMaybe' = listToMaybe -- from Data.Maybe

10691070```

10701071

1071−(`NT` comes from "natural transformation", in case you're wondering.)

1072+Note that `servant` doesn't declare the `~>` type-alias, as the unfolded

1073+variant isn't much longer to write, as we'll see shortly.

10721074

10731075So if you want to write handlers using another monad/type than `Handler`, say the `Reader String` monad, the first thing you have to

10741076prepare is a function:

10751077

10761078``` haskell ignore

1077−readerToHandler :: Reader String :~> Handler

1079+readerToHandler :: Reader String a -> Handler a

10781080```

10791081

1080−Let's start with `readerToHandler'`. We obviously have to run the `Reader`

1081−computation by supplying it with a `String`, like `"hi"`. We get an `a` out

1082−from that and can then just `return` it into `Handler`. We can then just wrap

1083−that function with the `NT` constructor to make it have the fancier type.

1082+We obviously have to run the `Reader` computation by supplying it with a

1083+`String`, like `"hi"`. We get an `a` out from that and can then just `return`

1084+it into `Handler`.

10841085

10851086``` haskell

1086−readerToHandler' :: forall a. Reader String a -> Handler a

1087−readerToHandler' r = return (runReader r "hi")

1088−

1089−readerToHandler :: Reader String :~> Handler

1090−readerToHandler = NT readerToHandler'

1087+readerToHandler :: Reader String a -> Handler a

1088+readerToHandler r = return (runReader r "hi")

10911089```

10921090

10931091We can write some simple webservice with the handlers running in `Reader String`.

10941092

10951093``` haskell

10961094type ReaderAPI = "a" :> Get '[JSON] Int

1097− :<|> "b" :> Get '[JSON] String

1095+ :<|> "b" :> ReqBody '[JSON] Double :> Get '[JSON] Bool

10981096

10991097readerAPI :: Proxy ReaderAPI

11001098readerAPI = Proxy

11011099

11021100readerServerT :: ServerT ReaderAPI (Reader String)

1103−readerServerT = a :<|> b

1104−

1105− where a :: Reader String Int

1106− a = return 1797

1101+readerServerT = a :<|> b where

1102+ a :: Reader String Int

1103+ a = return 1797

11071104

1108− b :: Reader String String

1109− b = ask

1105+ b :: Double -> Reader String Bool

1106+ b _ = asks (== "hi")

11101107```

11111108

11121109We unfortunately can't use `readerServerT` as an argument of `serve`, because

11131110`serve` wants a `Server ReaderAPI`, i.e., with handlers running in `Handler`. But there's a simple solution to this.

11141111

1115−### Enter `enter`

1112+### Welcome `hoistServer`

11161113

11171114That's right. We have just written `readerToHandler`, which is exactly what we

11181115would need to apply to all handlers to make the handlers have the

11191116right type for `serve`. Being cumbersome to do by hand, we provide a function

1120−`enter` which takes a natural transformation between two parametrized types `m`

1117+`hoistServer` which takes a natural transformation between two parametrized types `m`

11211118and `n` and a `ServerT someapi m`, and returns a `ServerT someapi n`.

11221119

1123−In our case, we can wrap up our little webservice by using `enter

1124−readerToHandler` on our handlers.

1120+In our case, we can wrap up our little webservice by using

1121+`hoistServer readerAPI readerToHandler` on our handlers.

11251122

11261123``` haskell

11271124readerServer :: Server ReaderAPI

1128−readerServer = enter readerToHandler readerServerT

1125+readerServer = hoistServer readerAPI readerToHandler readerServerT

11291126

11301127app4 :: Application

11311128app4 = serve readerAPI readerServer

@@ -1140,6 +1137,33 @@ $ curl http://localhost:8081/b

11401137"hi"

11411138```

11421139

1140+### An arrow is a reader too.

1141+

1142+In previous versions of `servant` we had an `enter` to do what `hoistServer`

1143+does now. `enter` had a ambitious design goals, but was problematic in practice.

1144+

1145+One problematic situation was when the source monad was `(->) r`, yet it's

1146+handy in practice, because `(->) r` is isomorphic to `Reader r`.

1147+

1148+We can rewrite the previous example without `Reader`:

1149+

1150+```haskell

1151+funServerT :: ServerT ReaderAPI ((->) String)

1152+funServerT = a :<|> b where

1153+ a :: String -> Int

1154+ a _ = 1797

1155+

1156+ -- unfortunately, we cannot make `String` the first argument.

1157+ b :: Double -> String -> Bool

1158+ b _ s = s == "hi"

1159+

1160+funToHandler :: (String -> a) -> Handler a

1161+funToHandler f = return (f "hi")

1162+

1163+app5 :: Application

1164+app5 = serve readerAPI (hoistServer readerAPI funToHandler funServerT)

1165+```

1166+

11431167## Conclusion

11441168

11451169You're now equipped to write webservices/web-applications using

servant-server/src/Servant/Server.hs+29−41

@@ -2,6 +2,7 @@

22{-# LANGUAGE DataKinds #-}

33{-# LANGUAGE FlexibleContexts #-}

44{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE RankNTypes #-}

56{-# LANGUAGE TypeFamilies #-}

78-- | This module lets you implement 'Server's for defined APIs. You'll

@@ -26,24 +27,10 @@ module Servant.Server

2627 , layout

2728 , layoutWithContext

2829

29− -- * Enter

30− -- $enterDoc

31−

32− -- ** Basic functions and datatypes

33− , enter

34− , (:~>)(..)

35− -- ** `Nat` utilities

36− , liftNat

37− , runReaderTNat

38− , evalStateTLNat

39− , evalStateTSNat

40− , logWriterTLNat

41− , logWriterTSNat

30+ -- * Enter / hoisting server

31+ , hoistServer

32+

4233 -- ** Functions based on <https://hackage.haskell.org/package/mmorph mmorph>

43− , hoistNat

44− , embedNat

45− , squashNat

46− , generalizeNat

4734 , tweakResponse

4835

4936 -- * Context

@@ -106,12 +93,11 @@ module Servant.Server

10693

10794 ) where

10895

109−import Data.Proxy (Proxy)

96+import Data.Proxy (Proxy (..))

11097import Data.Tagged (Tagged (..))

11198import Data.Text (Text)

11299import Network.Wai (Application)

113100import Servant.Server.Internal

114−import Servant.Utils.Enter

115101

116102

117103-- * Implementing Servers

@@ -145,6 +131,30 @@ serveWithContext :: (HasServer api context)

145131serveWithContext p context server =

146132 toApplication (runRouter (route p context (emptyDelayed (Route server))))

147133

134+-- | Hoist server implementation.

135+--

136+-- Sometimes our cherished `Handler` monad isn't quite the type you'd like for

137+-- your handlers. Maybe you want to thread some configuration in a @Reader@

138+-- monad. Or have your types ensure that your handlers don't do any IO. Use

139+-- `hoistServer` (a successor of now deprecated @enter@).

140+--

141+-- With `hoistServer`, you can provide a function,

142+-- to convert any number of endpoints from one type constructor to

143+-- another. For example

144+--

145+-- /Note:/ 'Server' 'Raw' can also be entered. It will be retagged.

146+--

147+-- >>> import Control.Monad.Reader

148+-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI

149+-- >>> let readerApi = Proxy :: Proxy ReaderAPI

150+-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)

151+-- >>> let nt x = return (runReader x "hi")

152+-- >>> let mainServer = hoistServer readerApi nt readerServer :: Server ReaderAPI

153+--

154+hoistServer :: (HasServer api '[]) => Proxy api

155+ -> (forall x. m x -> n x) -> ServerT api m -> ServerT api n

156+hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])

157+

148158-- | The function 'layout' produces a textual description of the internal

149159-- router layout for debugging purposes. Note that the router layout is

150160-- determined just by the API, not by the handlers.

@@ -205,28 +215,6 @@ layoutWithContext :: (HasServer api context)

205215layoutWithContext p context =

206216 routerLayout (route p context (emptyDelayed (FailFatal err501)))

207217

208−-- Documentation

209−

210−-- $enterDoc

211−-- Sometimes our cherished `ExceptT` monad isn't quite the type you'd like for

212−-- your handlers. Maybe you want to thread some configuration in a @Reader@

213−-- monad. Or have your types ensure that your handlers don't do any IO. Enter

214−-- `enter`.

215−--

216−-- With `enter`, you can provide a function, wrapped in the `(:~>)` / `NT`

217−-- newtype, to convert any number of endpoints from one type constructor to

218−-- another. For example

219−--

220−-- /Note:/ 'Server' 'Raw' can also be entered. It will be retagged.

221−--

222−-- >>> import Control.Monad.Reader

223−-- >>> import qualified Control.Category as C

224−-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI

225−-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)

226−-- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler

227−-- >>> let mainServer = enter nt readerServer :: Server ReaderAPI

228−--

229−

230218-- $setup

231219-- >>> :set -XDataKinds

232220-- >>> :set -XTypeOperators

servant-server/src/Servant/Server/Experimental/Auth.hs+1−1

@@ -57,7 +57,7 @@ instance ( HasServer api context

5757 type ServerT (AuthProtect tag :> api) m =

5858 AuthServerData (AuthProtect tag) -> ServerT api m

5959

60− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

60+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

6161

6262 route Proxy context subserver =

6363 route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)

servant-server/src/Servant/Server/Internal.hs+24−24

@@ -86,7 +86,7 @@ class HasServer api context where

8686 -> Delayed env (Server api)

8787 -> Router env

8888

89− hoistServer

89+ hoistServerWithContext

9090 :: Proxy api

9191 -> Proxy context

9292 -> (forall x. m x -> n x)

@@ -118,9 +118,9 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont

118118 pb = Proxy :: Proxy b

119119

120120 -- | This is better than 'enter', as it's tailor made for 'HasServer'.

121− hoistServer _ pc nt (a :<|> b) =

122− hoistServer (Proxy :: Proxy a) pc nt a :<|>

123− hoistServer (Proxy :: Proxy b) pc nt b

121+ hoistServerWithContext _ pc nt (a :<|> b) =

122+ hoistServerWithContext (Proxy :: Proxy a) pc nt a :<|>

123+ hoistServerWithContext (Proxy :: Proxy b) pc nt b

124124

125125-- | If you use 'Capture' in one of the endpoints for your API,

126126-- this automatically requires your server-side handler to be a function

@@ -145,7 +145,7 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)

145145 type ServerT (Capture capture a :> api) m =

146146 a -> ServerT api m

147147

148− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

148+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

149149

150150 route Proxy context d =

151151 CaptureRouter $

@@ -179,7 +179,7 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)

179179 type ServerT (CaptureAll capture a :> api) m =

180180 [a] -> ServerT api m

181181

182− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

182+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

183183

184184 route Proxy context d =

185185 CaptureAllRouter $

@@ -258,7 +258,7 @@ instance OVERLAPPABLE_

258258 ) => HasServer (Verb method status ctypes a) context where

259259

260260 type ServerT (Verb method status ctypes a) m = m a

261− hoistServer _ _ nt s = nt s

261+ hoistServerWithContext _ _ nt s = nt s

262262

263263 route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status

264264 where method = reflectMethod (Proxy :: Proxy method)

@@ -270,7 +270,7 @@ instance OVERLAPPING_

270270 ) => HasServer (Verb method status ctypes (Headers h a)) context where

271271

272272 type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)

273− hoistServer _ _ nt s = nt s

273+ hoistServerWithContext _ _ nt s = nt s

274274

275275 route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status

276276 where method = reflectMethod (Proxy :: Proxy method)

@@ -302,7 +302,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)

302302 type ServerT (Header sym a :> api) m =

303303 Maybe a -> ServerT api m

304304

305− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

305+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

306306

307307 route Proxy context subserver = route (Proxy :: Proxy api) context $

308308 subserver `addHeaderCheck` withRequest headerCheck

@@ -347,7 +347,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)

347347 type ServerT (QueryParam sym a :> api) m =

348348 Maybe a -> ServerT api m

349349

350− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

350+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

351351

352352 route Proxy context subserver =

353353 let querytext req = parseQueryText $ rawQueryString req

@@ -394,7 +394,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)

394394 type ServerT (QueryParams sym a :> api) m =

395395 [a] -> ServerT api m

396396

397− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

397+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

398398

399399 route Proxy context subserver = route (Proxy :: Proxy api) context $

400400 subserver `addParameterCheck` withRequest paramsCheck

@@ -436,7 +436,7 @@ instance (KnownSymbol sym, HasServer api context)

436436 type ServerT (QueryFlag sym :> api) m =

437437 Bool -> ServerT api m

438438

439− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

439+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

440440

441441 route Proxy context subserver =

442442 let querytext r = parseQueryText $ rawQueryString r

@@ -461,7 +461,7 @@ instance HasServer Raw context where

461461

462462 type ServerT Raw m = Tagged m Application

463463

464− hoistServer _ _ _ = retag

464+ hoistServerWithContext _ _ _ = retag

465465

466466 route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do

467467 -- note: a Raw application doesn't register any cleanup

@@ -502,7 +502,7 @@ instance ( AllCTUnrender list a, HasServer api context

502502 type ServerT (ReqBody list a :> api) m =

503503 a -> ServerT api m

504504

505− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

505+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

506506

507507 route Proxy context subserver

508508 = route (Proxy :: Proxy api) context $

@@ -538,14 +538,14 @@ instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) co

538538 (cs (symbolVal proxyPath))

539539 (route (Proxy :: Proxy api) context subserver)

540540 where proxyPath = Proxy :: Proxy path

541− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s

541+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s

542542

543543instance HasServer api context => HasServer (RemoteHost :> api) context where

544544 type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m

545545

546546 route Proxy context subserver =

547547 route (Proxy :: Proxy api) context (passToServer subserver remoteHost)

548− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

548+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

549549

550550instance HasServer api context => HasServer (IsSecure :> api) context where

551551 type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m

@@ -554,35 +554,35 @@ instance HasServer api context => HasServer (IsSecure :> api) context where

554554 route (Proxy :: Proxy api) context (passToServer subserver secure)

555555 where secure req = if isSecure req then Secure else NotSecure

556556

557− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

557+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

558558

559559instance HasServer api context => HasServer (Vault :> api) context where

560560 type ServerT (Vault :> api) m = Vault -> ServerT api m

561561

562562 route Proxy context subserver =

563563 route (Proxy :: Proxy api) context (passToServer subserver vault)

564− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

564+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

565565

566566instance HasServer api context => HasServer (HttpVersion :> api) context where

567567 type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m

568568

569569 route Proxy context subserver =

570570 route (Proxy :: Proxy api) context (passToServer subserver httpVersion)

571− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

571+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

572572

573573-- | Ignore @'Summary'@ in server handlers.

574574instance HasServer api ctx => HasServer (Summary desc :> api) ctx where

575575 type ServerT (Summary desc :> api) m = ServerT api m

576576

577577 route _ = route (Proxy :: Proxy api)

578− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s

578+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s

579579

580580-- | Ignore @'Description'@ in server handlers.

581581instance HasServer api ctx => HasServer (Description desc :> api) ctx where

582582 type ServerT (Description desc :> api) m = ServerT api m

583583

584584 route _ = route (Proxy :: Proxy api)

585− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt s

585+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s

586586

587587-- | Singleton type representing a server that serves an empty API.

588588data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)

@@ -602,7 +602,7 @@ instance HasServer EmptyAPI context where

602602

603603 route Proxy _ _ = StaticRouter mempty mempty

604604

605− hoistServer _ _ _ = retag

605+ hoistServerWithContext _ _ _ = retag

606606

607607-- | Basic Authentication

608608instance ( KnownSymbol realm

@@ -620,7 +620,7 @@ instance ( KnownSymbol realm

620620 basicAuthContext = getContextEntry context

621621 authCheck = withRequest $ \ req -> runBasicAuth req realm basicAuthContext

622622

623− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy api) pc nt . s

623+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

624624

625625-- * helpers

626626

@@ -647,4 +647,4 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

647647 subContext :: Context subContext

648648 subContext = descendIntoNamedContext (Proxy :: Proxy name) context

649649

650− hoistServer _ _ nt s = hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

650+ hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

servant-server/test/Servant/ArbitraryMonadServerSpec.hs+9−7

@@ -3,9 +3,8 @@

33{-# LANGUAGE TypeOperators #-}

44module Servant.ArbitraryMonadServerSpec where

6−import qualified Control.Category as C

76import Control.Monad.Reader

8−import Data.Functor.Identity

7+import Data.Functor.Identity

98import Data.Proxy

109import Servant.API

1110import Servant.Server

@@ -28,23 +27,26 @@ type CombinedAPI = ReaderAPI :<|> IdentityAPI

2827readerAPI :: Proxy ReaderAPI

2928readerAPI = Proxy

3029

30+identityAPI :: Proxy IdentityAPI

31+identityAPI = Proxy

32+

3133combinedAPI :: Proxy CombinedAPI

3234combinedAPI = Proxy

3335

3436readerServer' :: ServerT ReaderAPI (Reader String)

3537readerServer' = return 1797 :<|> ask

3638

37−fReader :: Reader String :~> Handler

38−fReader = generalizeNat C.. (runReaderTNat "hi")

39+fReader :: Reader String a -> Handler a

40+fReader x = return (runReader x "hi")

3941

4042readerServer :: Server ReaderAPI

41−readerServer = enter fReader readerServer'

43+readerServer = hoistServer readerAPI fReader readerServer'

4244

4345combinedReaderServer' :: ServerT CombinedAPI (Reader String)

44−combinedReaderServer' = readerServer' :<|> enter (generalizeNat :: Identity :~> Reader String) (return True)

46+combinedReaderServer' = readerServer' :<|> hoistServer identityAPI (return . runIdentity) (return True)

4547

4648combinedReaderServer :: Server CombinedAPI

47−combinedReaderServer = enter fReader combinedReaderServer'

49+combinedReaderServer = hoistServer combinedAPI fReader combinedReaderServer'

4850

4951enterSpec :: Spec

5052enterSpec = describe "Enter" $ do

servant-server/test/Servant/HoistSpec.hsnew file+38

@@ -0,0 +1,38 @@

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE TypeOperators #-}

3+module Servant.HoistSpec where

5+import Test.Hspec (Spec)

7+import Servant

9+-------------------------------------------------------------------------------

10+-- https://github.com/haskell-servant/servant/issues/734

11+-------------------------------------------------------------------------------

12+

13+-- This didn't fail if executed in GHCi; cannot have as a doctest.

14+

15+newtype App a = App a

16+

17+type API = Get '[JSON] Int

18+ :<|> ReqBody '[JSON] String :> Get '[JSON] Bool

19+

20+api :: Proxy API

21+api = Proxy

22+

23+server :: App Int :<|> (String -> App Bool)

24+server = undefined

25+

26+-- Natural transformation still seems to need an explicit type.

27+f :: App a -> App a

28+f = id

29+

30+server' :: App Int :<|> (String -> App Bool)

31+server' = hoistServer api f server

32+

33+-------------------------------------------------------------------------------

34+-- Spec

35+-------------------------------------------------------------------------------

36+

37+spec :: Spec

38+spec = return ()

servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs+1−1

@@ -89,7 +89,7 @@ data Res (sym :: Symbol)

8989instance (KnownSymbol sym, HasServer api ctx) => HasServer (Res sym :> api) ctx where

9090 type ServerT (Res sym :> api) m = IORef (TestResource String) -> ServerT api m

9191

92− hoistServer _ nc nt s = hoistServer (Proxy :: Proxy api) nc nt . s

92+ hoistServerWithContext _ nc nt s = hoistServerWithContext (Proxy :: Proxy api) nc nt . s

9393

9494 route Proxy ctx server = route (Proxy :: Proxy api) ctx $

9595 addBodyCheck server (return ()) check

servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hs+5−5

@@ -29,7 +29,7 @@ instance (HasContextEntry context String, HasServer subApi context) =>

2929 type ServerT (ExtractFromContext :> subApi) m =

3030 String -> ServerT subApi m

3131

32− hoistServer _ pc nt s = hoistServer (Proxy :: Proxy subApi) pc nt . s

32+ hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s

3333

3434 route Proxy context delayed =

3535 route subProxy context (fmap inject delayed)

@@ -47,8 +47,8 @@ instance (HasServer subApi (String ': context)) =>

4747 type ServerT (InjectIntoContext :> subApi) m =

4848 ServerT subApi m

4949

50− hoistServer _ _ nt s =

51− hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy (String ': context)) nt s

50+ hoistServerWithContext _ _ nt s =

51+ hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy (String ': context)) nt s

5252

5353 route Proxy context delayed =

5454 route subProxy newContext delayed

@@ -66,8 +66,8 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

6666 type ServerT (NamedContextWithBirdface name subContext :> subApi) m =

6767 ServerT subApi m

6868

69− hoistServer _ _ nt s =

70− hoistServer (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

69+ hoistServerWithContext _ _ nt s =

70+ hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s

7171

7272 route Proxy context delayed =

7373 route subProxy subContext delayed

servant/src/Servant/Utils/Enter.hs+1−1

@@ -8,7 +8,7 @@

88{-# LANGUAGE TypeFamilies #-}

99{-# LANGUAGE TypeOperators #-}

1010{-# LANGUAGE UndecidableInstances #-}

11−module Servant.Utils.Enter (

11+module Servant.Utils.Enter {-# DEPRECATED "Use hoistServer or hoistServerWithContext from servant-server" #-} (

1212 module Servant.Utils.Enter,

1313 -- * natural-transformation re-exports

1414 (:~>)(..),

servant/test/Servant/Utils/EnterSpec.hs+1

@@ -1,5 +1,6 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE TypeOperators #-}

3+{-# OPTIONS_GHC -fno-warn-deprecations #-}

34module Servant.Utils.EnterSpec where

56import Test.Hspec (Spec)