Skip to content

Commit df09f86

Browse files
soenkehahnsoenkehahn
committed
config: remove HasConfig and make HasServer take config as a parameter
1 parent 35bdc54 commit df09f86

File tree

9 files changed

+94
-105
lines changed

9 files changed

+94
-105
lines changed

‎servant-client/test/Servant/ClientSpec.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -288,9 +288,8 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
288288
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
289289

290290
data 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

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -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

912
import Data.Aeson
1013
import Data.ByteString (ByteString)
@@ -32,10 +35,10 @@ isGoodCookie ref password = do
3235

3336
data 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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,4 +20,4 @@ api :: Proxy API
2020
api = Proxy
2121

2222
main :: 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

Lines changed: 40 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -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,14 +67,15 @@ import Network.HTTP.Types.Status
6667
import Network.Wai
6768
import Servant
6869
import Servant.API.ContentTypes
70+
import Servant.Server.Internal.Config
6971
import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
7072
import Test.QuickCheck.Gen (Gen, generate)
7173

7274
-- | 'HasMock' defines an interpretation of API types
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

146148
instance (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

150152
instance 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

166170
mockArbitrary :: (MonadIO m, Arbitrary a) => m a
167171
mockArbitrary = liftIO (generate arbitrary)

‎servant-mock/test/Servant/MockSpec.hs

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -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
2123
import 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

2628
data 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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -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
115115
serve p config server = toApplication (runRouter (route p config d))
116116
where
117117
d = Delayed r r r (\ _ _ -> Route server)

0 commit comments

Comments
 (0)