git.iko.soy/typeable/servant
on master help sign in
config: remove HasConfig and make HasServer take `config` as a parameter
commitdf09f8616e453c638422b5e3067b69120ed35088 authorSönke Hahn <soenkehahn@gmail.com> dateTue 19 Jan 2016, 00:19 (11 years ago) parent35bdc54
9 files changed+94−105
compare with master
unifiedsplit
servant-client/test/Servant/ClientSpec.hs+2−3 servant-examples/auth-combinator/auth-combinator.hs+6−3 servant-mock/example/main.hs+1−1 servant-mock/src/Servant/Mock.hs+40−36 servant-mock/test/Servant/MockSpec.hs+6−4 servant-server/src/Servant/Server.hs+2−2 servant-server/src/Servant/Server/Internal.hs+27−42 servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs+7−12 servant-server/test/Servant/ServerSpec.hs+3−2
servant-client/test/Servant/ClientSpec.hs+2−3
@@ -288,9 +288,8 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
288288 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
289289
290290data WrappedApi where
291− WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a
292− , HasConfig api '[], HasClient api
293− , Client api ~ ExceptT ServantError IO ()) =>
291+ WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
292+ HasClient api, Client api ~ ExceptT ServantError IO ()) =>
294293 Proxy api -> WrappedApi
295294
296295
servant-examples/auth-combinator/auth-combinator.hs+6−3
@@ -1,10 +1,13 @@
11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
46{-# LANGUAGE OverloadedStrings #-}
57{-# LANGUAGE ScopedTypeVariables #-}
68{-# LANGUAGE TypeFamilies #-}
79{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE UndecidableInstances #-}
811
912import Data.Aeson
1013import Data.ByteString (ByteString)
@@ -32,10 +35,10 @@ isGoodCookie ref password = do
3235
3336data AuthProtected
3437
35−instance HasServer rest => HasServer (AuthProtected :> rest) where
38+instance (HasConfigEntry config DBConnection, HasServer rest config)
39+ => HasServer (AuthProtected :> rest) config where
40+
3641 type ServerT (AuthProtected :> rest) m = ServerT rest m
37− type HasConfig (AuthProtected :> rest) config =
38− (HasConfigEntry config DBConnection, HasConfig rest config)
3942
4043 route Proxy config subserver = WithRequest $ \ request ->
4144 route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request
servant-mock/example/main.hs+1−1
@@ -20,4 +20,4 @@ api :: Proxy API
2020api = Proxy
2121
2222main :: IO ()
23−main = run 8080 (serve api EmptyConfig $ mock api)
23+main = run 8080 (serve api EmptyConfig $ mock api Proxy)
servant-mock/src/Servant/Mock.hs+40−36
@@ -2,8 +2,9 @@
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE FlexibleContexts #-}
44{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
66{-# LANGUAGE PolyKinds #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
78{-# LANGUAGE TypeFamilies #-}
89{-# LANGUAGE TypeOperators #-}
910{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -66,6 +67,7 @@ import Network.HTTP.Types.Status
6667import Network.Wai
6768import Servant
6869import Servant.API.ContentTypes
70+import Servant.Server.Internal.Config
6971import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
7072import Test.QuickCheck.Gen (Gen, generate)
7173
@@ -73,7 +75,7 @@ import Test.QuickCheck.Gen (Gen, generate)
7375-- than turns them into random-response-generating
7476-- request handlers, hence providing an instance for
7577-- all the combinators of the core /servant/ library.
76−class HasServer api => HasMock api where
78+class HasServer api config => HasMock api config where
7779 -- | Calling this method creates request handlers of
7880 -- the right type to implement the API described by
7981 -- @api@ that just generate random response values of
@@ -103,65 +105,67 @@ class HasServer api => HasMock api where
103105 -- So under the hood, 'mock' uses the 'IO' bit to generate
104106 -- random values of type 'User' and 'Book' every time these
105107 -- endpoints are requested.
106− mock :: Proxy api -> Server api
108+ mock :: Proxy api -> Proxy config -> Server api
107109
108−instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
109− mock _ = mock (Proxy :: Proxy a) :<|> mock (Proxy :: Proxy b)
110+instance (HasMock a config, HasMock b config) => HasMock (a :<|> b) config where
111+ mock _ config = mock (Proxy :: Proxy a) config :<|> mock (Proxy :: Proxy b) config
110112
111−instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
113+instance (KnownSymbol path, HasMock rest config) => HasMock (path :> rest) config where
112114 mock _ = mock (Proxy :: Proxy rest)
113115
114−instance (KnownSymbol s, FromHttpApiData a, HasMock rest) => HasMock (Capture s a :> rest) where
115− mock _ = \_ -> mock (Proxy :: Proxy rest)
116+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config) => HasMock (Capture s a :> rest) config where
117+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
116118
117−instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
118− mock _ = \_ -> mock (Proxy :: Proxy rest)
119+instance (AllCTUnrender ctypes a, HasMock rest config) => HasMock (ReqBody ctypes a :> rest) config where
120+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
119121
120−instance HasMock rest => HasMock (RemoteHost :> rest) where
121− mock _ = \_ -> mock (Proxy :: Proxy rest)
122+instance HasMock rest config => HasMock (RemoteHost :> rest) config where
123+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
122124
123−instance HasMock rest => HasMock (IsSecure :> rest) where
124− mock _ = \_ -> mock (Proxy :: Proxy rest)
125+instance HasMock rest config => HasMock (IsSecure :> rest) config where
126+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
125127
126−instance HasMock rest => HasMock (Vault :> rest) where
127− mock _ = \_ -> mock (Proxy :: Proxy rest)
128+instance HasMock rest config => HasMock (Vault :> rest) config where
129+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
128130
129−instance HasMock rest => HasMock (HttpVersion :> rest) where
130− mock _ = \_ -> mock (Proxy :: Proxy rest)
131+instance HasMock rest config => HasMock (HttpVersion :> rest) config where
132+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
131133
132−instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
133− => HasMock (QueryParam s a :> rest) where
134− mock _ = \_ -> mock (Proxy :: Proxy rest)
134+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
135+ => HasMock (QueryParam s a :> rest) config where
136+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
135137
136−instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
137− => HasMock (QueryParams s a :> rest) where
138− mock _ = \_ -> mock (Proxy :: Proxy rest)
138+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
139+ => HasMock (QueryParams s a :> rest) config where
140+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
139141
140−instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
141− mock _ = \_ -> mock (Proxy :: Proxy rest)
142+instance (KnownSymbol s, HasMock rest config) => HasMock (QueryFlag s :> rest) config where
143+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
142144
143−instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
144− mock _ = \_ -> mock (Proxy :: Proxy rest)
145+instance (KnownSymbol h, FromHttpApiData a, HasMock rest config) => HasMock (Header h a :> rest) config where
146+ mock _ config = \_ -> mock (Proxy :: Proxy rest) config
145147
146148instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
147− => HasMock (Verb method status ctypes a) where
148− mock _ = mockArbitrary
149+ => HasMock (Verb method status ctypes a) config where
150+ mock _ _ = mockArbitrary
149151
150152instance OVERLAPPING_
151153 (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
152154 Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
153− => HasMock (Verb method status ctypes (Headers headerTypes a)) where
154− mock _ = mockArbitrary
155+ => HasMock (Verb method status ctypes (Headers headerTypes a)) config where
156+ mock _ _ = mockArbitrary
155157
156−instance HasMock Raw where
157− mock _ = \_req respond -> do
158+instance HasMock Raw config where
159+ mock _ _ = \_req respond -> do
158160 bdy <- genBody
159161 respond $ responseLBS status200 [] bdy
160162
161163 where genBody = pack <$> generate (vector 100 :: Gen [Char])
162164
163−instance HasMock rest => HasMock (WithNamedConfig name config rest) where
164− mock _ = mock (Proxy :: Proxy rest)
165+instance (HasConfigEntry config (NamedConfig name subConfig), HasMock rest subConfig) =>
166+ HasMock (WithNamedConfig name subConfig rest) config where
167+
168+ mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subConfig)
165169
166170mockArbitrary :: (MonadIO m, Arbitrary a) => m a
167171mockArbitrary = liftIO (generate arbitrary)
servant-mock/test/Servant/MockSpec.hs+6−4
@@ -1,5 +1,7 @@
1+{-# LANGUAGE ConstraintKinds #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleContexts #-}
35{-# LANGUAGE OverloadedStrings #-}
46{-# LANGUAGE TypeOperators #-}
57
@@ -21,7 +23,7 @@ import Servant.API.Internal.Test.ComprehensiveAPI
2123import Servant.Mock
2224
2325-- This declaration simply checks that all instances are in place.
24−_ = mock comprehensiveAPI
26+_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedConfig "foo" '[]])
2527
2628data Body
2729 = Body
@@ -50,7 +52,7 @@ spec = do
5052 context "Get" $ do
5153 let api :: Proxy (Get '[JSON] Body)
5254 api = Proxy
53− app = serve api (mock api)
55+ app = serve api EmptyConfig (mock api Proxy)
5456 with (return app) $ do
5557 it "serves arbitrary response bodies" $ do
5658 get "/" `shouldRespondWith` 200{
@@ -62,8 +64,8 @@ spec = do
6264 withHeader = Proxy
6365 withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
6466 withoutHeader = Proxy
65− toApp :: HasMock api => Proxy api -> IO Application
66− toApp api = return $ serve api (mock api)
67+ toApp :: (HasMock api '[]) => Proxy api -> IO Application
68+ toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))
6769 with (toApp withHeader) $ do
6870 it "serves arbitrary response bodies" $ do
6971 get "/" `shouldRespondWith` 200{
servant-server/src/Servant/Server.hs+2−2
@@ -110,8 +110,8 @@ import Servant.Server.Internal.Enter
110110-- > main :: IO ()
111111-- > main = Network.Wai.Handler.Warp.run 8080 app
112112--
113−serve :: (HasConfig layout a, HasServer layout)
114− => Proxy layout -> Config a -> Server layout -> Application
113+serve :: (HasServer layout config)
114+ => Proxy layout -> Config config -> Server layout -> Application
115115serve p config server = toApplication (runRouter (route p config d))
116116 where
117117 d = Delayed r r r (\ _ _ -> Route server)
servant-server/src/Servant/Server/Internal.hs+27−42
@@ -4,6 +4,7 @@
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
66{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
78{-# LANGUAGE OverloadedStrings #-}
89{-# LANGUAGE PolyKinds #-}
910{-# LANGUAGE ScopedTypeVariables #-}
@@ -68,11 +69,10 @@ import Servant.Server.Internal.RoutingApplication
6869import Servant.Server.Internal.ServantErr
6970
7071
71−class HasServer layout where
72+class HasServer layout config where
7273 type ServerT layout (m :: * -> *) :: *
73− type HasConfig layout (c :: [*]) :: Constraint
7474
75− route :: HasConfig layout config => Proxy layout -> Config config -> Delayed (Server layout) -> Router
75+ route :: Proxy layout -> Config config -> Delayed (Server layout) -> Router
7676
7777type Server layout = ServerT layout (ExceptT ServantErr IO)
7878
@@ -89,10 +89,9 @@ type Server layout = ServerT layout (ExceptT ServantErr IO)
8989-- > server = listAllBooks :<|> postBook
9090-- > where listAllBooks = ...
9191-- > postBook book = ...
92−instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
92+instance (HasServer a config, HasServer b config) => HasServer (a :<|> b) config where
9393
9494 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
95− type HasConfig (a :<|> b) c = (HasConfig a c, HasConfig b c)
9695
9796 route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server))
9897 (route pb config ((\ (_ :<|> b) -> b) <$> server))
@@ -119,12 +118,11 @@ captured _ = parseUrlPieceMaybe
119118-- > server = getBook
120119-- > where getBook :: Text -> ExceptT ServantErr IO Book
121120-- > getBook isbn = ...
122−instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
123− => HasServer (Capture capture a :> sublayout) where
121+instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout config)
122+ => HasServer (Capture capture a :> sublayout) config where
124123
125124 type ServerT (Capture capture a :> sublayout) m =
126125 a -> ServerT sublayout m
127− type HasConfig (Capture capture a :> sublayout) c = (HasConfig sublayout c)
128126
129127 route Proxy config d =
130128 DynamicRouter $ \ first ->
@@ -198,10 +196,9 @@ methodRouterHeaders method proxy status action = LeafRouter route'
198196
199197instance OVERLAPPABLE_
200198 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
201− ) => HasServer (Verb method status ctypes a) where
199+ ) => HasServer (Verb method status ctypes a) config where
202200
203201 type ServerT (Verb method status ctypes a) m = m a
204− type HasConfig (Verb method status ctypes a) c = ()
205202
206203 route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status
207204 where method = reflectMethod (Proxy :: Proxy method)
@@ -210,10 +207,9 @@ instance OVERLAPPABLE_
210207instance OVERLAPPING_
211208 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
212209 , GetHeaders (Headers h a)
213− ) => HasServer (Verb method status ctypes (Headers h a)) where
210+ ) => HasServer (Verb method status ctypes (Headers h a)) config where
214211
215212 type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
216− type HasConfig (Verb method status ctypes (Headers h a)) c = ()
217213
218214 route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status
219215 where method = reflectMethod (Proxy :: Proxy method)
@@ -239,12 +235,11 @@ instance OVERLAPPING_
239235-- > server = viewReferer
240236-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
241237-- > viewReferer referer = return referer
242−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
243− => HasServer (Header sym a :> sublayout) where
238+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
239+ => HasServer (Header sym a :> sublayout) config where
244240
245241 type ServerT (Header sym a :> sublayout) m =
246242 Maybe a -> ServerT sublayout m
247− type HasConfig (Header sym a :> sublayout) c = HasConfig sublayout c
248243
249244 route Proxy config subserver = WithRequest $ \ request ->
250245 let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
@@ -272,12 +267,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
272267-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
273268-- > getBooksBy Nothing = ...return all books...
274269-- > getBooksBy (Just author) = ...return books by the given author...
275−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
276− => HasServer (QueryParam sym a :> sublayout) where
270+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
271+ => HasServer (QueryParam sym a :> sublayout) config where
277272
278273 type ServerT (QueryParam sym a :> sublayout) m =
279274 Maybe a -> ServerT sublayout m
280− type HasConfig (QueryParam sym a :> sublayout) c = HasConfig sublayout c
281275
282276 route Proxy config subserver = WithRequest $ \ request ->
283277 let querytext = parseQueryText $ rawQueryString request
@@ -309,12 +303,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
309303-- > server = getBooksBy
310304-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
311305-- > getBooksBy authors = ...return all books by these authors...
312−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
313− => HasServer (QueryParams sym a :> sublayout) where
306+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
307+ => HasServer (QueryParams sym a :> sublayout) config where
314308
315309 type ServerT (QueryParams sym a :> sublayout) m =
316310 [a] -> ServerT sublayout m
317− type HasConfig (QueryParams sym a :> sublayout) c = HasConfig sublayout c
318311
319312 route Proxy config subserver = WithRequest $ \ request ->
320313 let querytext = parseQueryText $ rawQueryString request
@@ -341,12 +334,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
341334-- > server = getBooks
342335-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
343336-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
344−instance (KnownSymbol sym, HasServer sublayout)
345− => HasServer (QueryFlag sym :> sublayout) where
337+instance (KnownSymbol sym, HasServer sublayout config)
338+ => HasServer (QueryFlag sym :> sublayout) config where
346339
347340 type ServerT (QueryFlag sym :> sublayout) m =
348341 Bool -> ServerT sublayout m
349− type HasConfig (QueryFlag sym :> sublayout) c = HasConfig sublayout c
350342
351343 route Proxy config subserver = WithRequest $ \ request ->
352344 let querytext = parseQueryText $ rawQueryString request
@@ -367,10 +359,9 @@ instance (KnownSymbol sym, HasServer sublayout)
367359-- >
368360-- > server :: Server MyApi
369361-- > server = serveDirectory "/var/www/images"
370−instance HasServer Raw where
362+instance HasServer Raw config where
371363
372364 type ServerT Raw m = Application
373− type HasConfig Raw c = ()
374365
375366 route Proxy _ rawApplication = LeafRouter $ \ request respond -> do
376367 r <- runDelayed rawApplication
@@ -400,12 +391,11 @@ instance HasServer Raw where
400391-- > server = postBook
401392-- > where postBook :: Book -> ExceptT ServantErr IO Book
402393-- > postBook book = ...insert into your db...
403−instance ( AllCTUnrender list a, HasServer sublayout
404− ) => HasServer (ReqBody list a :> sublayout) where
394+instance ( AllCTUnrender list a, HasServer sublayout config
395+ ) => HasServer (ReqBody list a :> sublayout) config where
405396
406397 type ServerT (ReqBody list a :> sublayout) m =
407398 a -> ServerT sublayout m
408− type HasConfig (ReqBody list a :> sublayout) c = HasConfig sublayout c
409399
410400 route Proxy config subserver = WithRequest $ \ request ->
411401 route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request))
@@ -426,42 +416,37 @@ instance ( AllCTUnrender list a, HasServer sublayout
426416
427417-- | Make sure the incoming request starts with @"/path"@, strip it and
428418-- pass the rest of the request path to @sublayout@.
429−instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
419+instance (KnownSymbol path, HasServer sublayout config) => HasServer (path :> sublayout) config where
430420
431421 type ServerT (path :> sublayout) m = ServerT sublayout m
432− type HasConfig (path :> sublayout) c = HasConfig sublayout c
433422
434423 route Proxy config subserver = StaticRouter $
435424 M.singleton (cs (symbolVal proxyPath))
436425 (route (Proxy :: Proxy sublayout) config subserver)
437426 where proxyPath = Proxy :: Proxy path
438427
439−instance HasServer api => HasServer (RemoteHost :> api) where
428+instance HasServer api config => HasServer (RemoteHost :> api) config where
440429 type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
441− type HasConfig (RemoteHost :> api) c = HasConfig api c
442430
443431 route Proxy config subserver = WithRequest $ \req ->
444432 route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req)
445433
446−instance HasServer api => HasServer (IsSecure :> api) where
434+instance HasServer api config => HasServer (IsSecure :> api) config where
447435 type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
448− type HasConfig (IsSecure :> api) c = HasConfig api c
449436
450437 route Proxy config subserver = WithRequest $ \req ->
451438 route (Proxy :: Proxy api) config (passToServer subserver $ secure req)
452439
453440 where secure req = if isSecure req then Secure else NotSecure
454441
455−instance HasServer api => HasServer (Vault :> api) where
442+instance HasServer api config => HasServer (Vault :> api) config where
456443 type ServerT (Vault :> api) m = Vault -> ServerT api m
457− type HasConfig (Vault :> api) c = HasConfig api c
458444
459445 route Proxy config subserver = WithRequest $ \req ->
460446 route (Proxy :: Proxy api) config (passToServer subserver $ vault req)
461447
462−instance HasServer api => HasServer (HttpVersion :> api) where
448+instance HasServer api config => HasServer (HttpVersion :> api) config where
463449 type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
464− type HasConfig (HttpVersion :> api) c = HasConfig api c
465450
466451 route Proxy config subserver = WithRequest $ \req ->
467452 route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req)
@@ -477,11 +462,11 @@ ct_wildcard = "*" <> "/" <> "*" -- Because CPP
477462
478463-- * configs
479464
480−instance HasServer subApi => HasServer (WithNamedConfig name subConfig subApi) where
465+instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig)
466+ => HasServer (WithNamedConfig name subConfig subApi) config where
467+
481468 type ServerT (WithNamedConfig name subConfig subApi) m =
482469 ServerT subApi m
483− type HasConfig (WithNamedConfig name subConfig subApi) config =
484− (HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
485470
486471 route Proxy config delayed =
487472 route subProxy subConfig delayed
servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs+7−12
@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
56{-# LANGUAGE PolyKinds #-}
67{-# LANGUAGE ScopedTypeVariables #-}
78{-# LANGUAGE TypeFamilies #-}
@@ -24,13 +25,11 @@ import Servant.Server.Internal.RoutingApplication
2425
2526data ExtractFromConfig
2627
27−instance (HasServer subApi) =>
28− HasServer (ExtractFromConfig :> subApi) where
28+instance (HasConfigEntry config String, HasServer subApi config) =>
29+ HasServer (ExtractFromConfig :> subApi) config where
2930
3031 type ServerT (ExtractFromConfig :> subApi) m =
3132 String -> ServerT subApi m
32− type HasConfig (ExtractFromConfig :> subApi) (c :: [*]) =
33− (HasConfigEntry c String, HasConfig subApi c)
3433
3534 route Proxy config delayed =
3635 route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@@ -42,13 +41,11 @@ instance (HasServer subApi) =>
4241
4342data InjectIntoConfig
4443
45−instance (HasServer subApi) =>
46− HasServer (InjectIntoConfig :> subApi) where
44+instance (HasServer subApi (String ': config)) =>
45+ HasServer (InjectIntoConfig :> subApi) config where
4746
4847 type ServerT (InjectIntoConfig :> subApi) m =
4948 ServerT subApi m
50− type HasConfig (InjectIntoConfig :> subApi) c =
51− (HasConfig subApi (String ': c))
5249
5350 route Proxy config delayed =
5451 route subProxy newConfig delayed
@@ -60,13 +57,11 @@ instance (HasServer subApi) =>
6057
6158data NamedConfigWithBirdface (name :: Symbol) (subConfig :: [*])
6259
63−instance (HasServer subApi) =>
64− HasServer (NamedConfigWithBirdface name subConfig :> subApi) where
60+instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig) =>
61+ HasServer (NamedConfigWithBirdface name subConfig :> subApi) config where
6562
6663 type ServerT (NamedConfigWithBirdface name subConfig :> subApi) m =
6764 ServerT subApi m
68− type HasConfig (NamedConfigWithBirdface name subConfig :> subApi) config =
69− (HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
7065
7166 route Proxy config delayed =
7267 route subProxy subConfig delayed
servant-server/test/Servant/ServerSpec.hs+3−2
@@ -1,14 +1,15 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
46{-# LANGUAGE FlexibleInstances #-}
57{-# LANGUAGE OverloadedStrings #-}
68{-# LANGUAGE PolyKinds #-}
79{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeOperators #-}
910{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE TypeOperators #-}
1012{-# LANGUAGE TypeSynonymInstances #-}
11−{-# LANGUAGE FlexibleInstances #-}
1213
1314module Servant.ServerSpec where
1415