git.iko.soy/servant
on master help sign in
renaming: Config -> Context
8ef4d45Sönke Hahn
servant-client/src/Servant/Client.hs+2−2
compare with master
unifiedsplit
@@ -418,9 +418,9 @@ instance HasClient api => HasClient (IsSecure :> api) where
418 clientWithRoute (Proxy :: Proxy api) req baseurl manager
418 clientWithRoute (Proxy :: Proxy api) req baseurl manager
419
419
420instance HasClient subapi =>
420instance HasClient subapi =>
421− HasClient (WithNamedConfig name config subapi) where
421+ HasClient (WithNamedContext name context subapi) where
422
422
423− type Client (WithNamedConfig name config subapi) = Client subapi
423+ type Client (WithNamedContext name context subapi) = Client subapi
424 clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
424 clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
425
425
426
426
servant-docs/src/Servant/Docs/Internal.hs+1−1
@@ -794,7 +794,7 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
794 docsFor Proxy ep =
794 docsFor Proxy ep =
795 docsFor (Proxy :: Proxy sublayout) ep
795 docsFor (Proxy :: Proxy sublayout) ep
796
796
797−instance HasDocs sublayout => HasDocs (WithNamedConfig name config sublayout) where
797+instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where
798 docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
798 docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
799
799
800-- ToSample instances for simple types
800-- ToSample instances for simple types
servant-examples/auth-combinator/auth-combinator.hs+7−7
@@ -35,18 +35,18 @@ isGoodCookie ref password = do
35
35
36data AuthProtected
36data AuthProtected
37
37
38−instance (HasConfigEntry config DBConnection, HasServer rest config)
38+instance (HasContextEntry context DBConnection, HasServer rest context)
39− => HasServer (AuthProtected :> rest) config where
39+ => HasServer (AuthProtected :> rest) context where
40
40
41 type ServerT (AuthProtected :> rest) m = ServerT rest m
41 type ServerT (AuthProtected :> rest) m = ServerT rest m
42
42
43− route Proxy config subserver = WithRequest $ \ request ->
43+ route Proxy context subserver = WithRequest $ \ request ->
44− route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request
44+ route (Proxy :: Proxy rest) context $ addAcceptCheck subserver $ cookieCheck request
45 where
45 where
46 cookieCheck req = case lookup "Cookie" (requestHeaders req) of
46 cookieCheck req = case lookup "Cookie" (requestHeaders req) of
47 Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" }
47 Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" }
48 Just v -> do
48 Just v -> do
49− let dbConnection = getConfigEntry config
49+ let dbConnection = getContextEntry context
50 authGranted <- isGoodCookie dbConnection v
50 authGranted <- isGoodCookie dbConnection v
51 if authGranted
51 if authGranted
52 then return $ Route ()
52 then return $ Route ()
@@ -81,8 +81,8 @@ server = return prvdata :<|> return pubdata
81main :: IO ()
81main :: IO ()
82main = do
82main = do
83 dbConnection <- initDB
83 dbConnection <- initDB
84− let config = dbConnection :. EmptyConfig
84+ let context = dbConnection :. EmptyContext
85− run 8080 (serveWithConfig api config server)
85+ run 8080 (serveWithContext api context server)
86
86
87{- Sample session:
87{- Sample session:
88$ curl http://localhost:8080/
88$ curl http://localhost:8080/
servant-examples/wai-middleware/wai-middleware.hs+1−1
@@ -41,7 +41,7 @@ server = return products
41
41
42-- logStdout :: Middleware
42-- logStdout :: Middleware
43-- i.e, logStdout :: Application -> Application
43-- i.e, logStdout :: Application -> Application
44−-- serve :: Proxy api -> Config config -> Server api -> Application
44+-- serve :: Proxy api -> Context context -> Server api -> Application
45-- so applying a middleware is really as simple as
45-- so applying a middleware is really as simple as
46-- applying a function to the result of 'serve'
46-- applying a function to the result of 'serve'
47app :: Application
47app :: Application
servant-foreign/src/Servant/Foreign/Internal.hs+2−2
@@ -310,9 +310,9 @@ instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
310 foreignFor lang (Proxy :: Proxy sublayout) req
310 foreignFor lang (Proxy :: Proxy sublayout) req
311
311
312instance HasForeign lang sublayout =>
312instance HasForeign lang sublayout =>
313− HasForeign lang (WithNamedConfig name config sublayout) where
313+ HasForeign lang (WithNamedContext name context sublayout) where
314
314
315− type Foreign (WithNamedConfig name config sublayout) = Foreign sublayout
315+ type Foreign (WithNamedContext name context sublayout) = Foreign sublayout
316
316
317 foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
317 foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout)
318
318
servant-mock/src/Servant/Mock.hs+33−33
@@ -74,7 +74,7 @@ import Test.QuickCheck.Gen (Gen, generate)
74-- than turns them into random-response-generating
74-- than turns them into random-response-generating
75-- request handlers, hence providing an instance for
75-- request handlers, hence providing an instance for
76-- all the combinators of the core /servant/ library.
76-- all the combinators of the core /servant/ library.
77−class HasServer api config => HasMock api config where
77+class HasServer api context => HasMock api context where
78 -- | Calling this method creates request handlers of
78 -- | Calling this method creates request handlers of
79 -- the right type to implement the API described by
79 -- the right type to implement the API described by
80 -- @api@ that just generate random response values of
80 -- @api@ that just generate random response values of
@@ -104,67 +104,67 @@ class HasServer api config => HasMock api config where
104 -- So under the hood, 'mock' uses the 'IO' bit to generate
104 -- So under the hood, 'mock' uses the 'IO' bit to generate
105 -- random values of type 'User' and 'Book' every time these
105 -- random values of type 'User' and 'Book' every time these
106 -- endpoints are requested.
106 -- endpoints are requested.
107− mock :: Proxy api -> Proxy config -> Server api
107+ mock :: Proxy api -> Proxy context -> Server api
108
108
109−instance (HasMock a config, HasMock b config) => HasMock (a :<|> b) config where
109+instance (HasMock a context, HasMock b context) => HasMock (a :<|> b) context where
110− mock _ config = mock (Proxy :: Proxy a) config :<|> mock (Proxy :: Proxy b) config
110+ mock _ context = mock (Proxy :: Proxy a) context :<|> mock (Proxy :: Proxy b) context
111
111
112−instance (KnownSymbol path, HasMock rest config) => HasMock (path :> rest) config where
112+instance (KnownSymbol path, HasMock rest context) => HasMock (path :> rest) context where
113 mock _ = mock (Proxy :: Proxy rest)
113 mock _ = mock (Proxy :: Proxy rest)
114
114
115−instance (KnownSymbol s, FromHttpApiData a, HasMock rest config) => HasMock (Capture s a :> rest) config where
115+instance (KnownSymbol s, FromHttpApiData a, HasMock rest context) => HasMock (Capture s a :> rest) context where
116− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
116+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
117
117
118−instance (AllCTUnrender ctypes a, HasMock rest config) => HasMock (ReqBody ctypes a :> rest) config where
118+instance (AllCTUnrender ctypes a, HasMock rest context) => HasMock (ReqBody ctypes a :> rest) context where
119− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
119+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
120
120
121−instance HasMock rest config => HasMock (RemoteHost :> rest) config where
121+instance HasMock rest context => HasMock (RemoteHost :> rest) context where
122− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
122+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
123
123
124−instance HasMock rest config => HasMock (IsSecure :> rest) config where
124+instance HasMock rest context => HasMock (IsSecure :> rest) context where
125− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
125+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
126
126
127−instance HasMock rest config => HasMock (Vault :> rest) config where
127+instance HasMock rest context => HasMock (Vault :> rest) context where
128− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
128+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
129
129
130−instance HasMock rest config => HasMock (HttpVersion :> rest) config where
130+instance HasMock rest context => HasMock (HttpVersion :> rest) context where
131− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
131+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
132
132
133−instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
133+instance (KnownSymbol s, FromHttpApiData a, HasMock rest context)
134− => HasMock (QueryParam s a :> rest) config where
134+ => HasMock (QueryParam s a :> rest) context where
135− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
135+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
136
136
137−instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
137+instance (KnownSymbol s, FromHttpApiData a, HasMock rest context)
138− => HasMock (QueryParams s a :> rest) config where
138+ => HasMock (QueryParams s a :> rest) context where
139− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
139+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
140
140
141−instance (KnownSymbol s, HasMock rest config) => HasMock (QueryFlag s :> rest) config where
141+instance (KnownSymbol s, HasMock rest context) => HasMock (QueryFlag s :> rest) context where
142− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
142+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
143
143
144−instance (KnownSymbol h, FromHttpApiData a, HasMock rest config) => HasMock (Header h a :> rest) config where
144+instance (KnownSymbol h, FromHttpApiData a, HasMock rest context) => HasMock (Header h a :> rest) context where
145− mock _ config = \_ -> mock (Proxy :: Proxy rest) config
145+ mock _ context = \_ -> mock (Proxy :: Proxy rest) context
146
146
147instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
147instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
148− => HasMock (Verb method status ctypes a) config where
148+ => HasMock (Verb method status ctypes a) context where
149 mock _ _ = mockArbitrary
149 mock _ _ = mockArbitrary
150
150
151instance OVERLAPPING_
151instance OVERLAPPING_
152 (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
152 (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
153 Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
153 Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
154− => HasMock (Verb method status ctypes (Headers headerTypes a)) config where
154+ => HasMock (Verb method status ctypes (Headers headerTypes a)) context where
155 mock _ _ = mockArbitrary
155 mock _ _ = mockArbitrary
156
156
157−instance HasMock Raw config where
157+instance HasMock Raw context where
158 mock _ _ = \_req respond -> do
158 mock _ _ = \_req respond -> do
159 bdy <- genBody
159 bdy <- genBody
160 respond $ responseLBS status200 [] bdy
160 respond $ responseLBS status200 [] bdy
161
161
162 where genBody = pack <$> generate (vector 100 :: Gen [Char])
162 where genBody = pack <$> generate (vector 100 :: Gen [Char])
163
163
164−instance (HasConfigEntry config (NamedConfig name subConfig), HasMock rest subConfig) =>
164+instance (HasContextEntry context (NamedContext name subContext), HasMock rest subContext) =>
165− HasMock (WithNamedConfig name subConfig rest) config where
165+ HasMock (WithNamedContext name subContext rest) context where
166
166
167− mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subConfig)
167+ mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subContext)
168
168
169mockArbitrary :: (MonadIO m, Arbitrary a) => m a
169mockArbitrary :: (MonadIO m, Arbitrary a) => m a
170mockArbitrary = liftIO (generate arbitrary)
170mockArbitrary = liftIO (generate arbitrary)
servant-mock/test/Servant/MockSpec.hs+1−1
@@ -23,7 +23,7 @@ import Servant.API.Internal.Test.ComprehensiveAPI
23import Servant.Mock
23import Servant.Mock
24
24
25-- This declaration simply checks that all instances are in place.
25-- This declaration simply checks that all instances are in place.
26−_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedConfig "foo" '[]])
26+_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedContext "foo" '[]])
27
27
28data Body
28data Body
29 = Body
29 = Body
servant-server/servant-server.cabal+4−4
@@ -37,7 +37,7 @@ library
37 Servant
37 Servant
38 Servant.Server
38 Servant.Server
39 Servant.Server.Internal
39 Servant.Server.Internal
40− Servant.Server.Internal.Config
40+ Servant.Server.Internal.Context
41 Servant.Server.Internal.Enter
41 Servant.Server.Internal.Enter
42 Servant.Server.Internal.Router
42 Servant.Server.Internal.Router
43 Servant.Server.Internal.RoutingApplication
43 Servant.Server.Internal.RoutingApplication
@@ -96,11 +96,11 @@ test-suite spec
96 main-is: Spec.hs
96 main-is: Spec.hs
97 other-modules:
97 other-modules:
98 Servant.Server.ErrorSpec
98 Servant.Server.ErrorSpec
99− Servant.Server.Internal.ConfigSpec
99+ Servant.Server.Internal.ContextSpec
100 Servant.Server.Internal.EnterSpec
100 Servant.Server.Internal.EnterSpec
101 Servant.ServerSpec
101 Servant.ServerSpec
102− Servant.Server.UsingConfigSpec
102+ Servant.Server.UsingContextSpec
103− Servant.Server.UsingConfigSpec.TestCombinators
103+ Servant.Server.UsingContextSpec.TestCombinators
104 Servant.Utils.StaticFilesSpec
104 Servant.Utils.StaticFilesSpec
105 build-depends:
105 build-depends:
106 base == 4.*
106 base == 4.*
servant-server/src/Servant/Server.hs+11−11
@@ -9,7 +9,7 @@
9module Servant.Server
9module Servant.Server
10 ( -- * Run a wai application from an API
10 ( -- * Run a wai application from an API
11 serve
11 serve
12− , serveWithConfig
12+ , serveWithContext
13
13
14 , -- * Construct a wai Application from an API
14 , -- * Construct a wai Application from an API
15 toApplication
15 toApplication
@@ -38,12 +38,12 @@ module Servant.Server
38 , generalizeNat
38 , generalizeNat
39 , tweakResponse
39 , tweakResponse
40
40
41− -- * Config
41+ -- * Context
42− , Config(..)
42+ , Context(..)
43− , HasConfigEntry(getConfigEntry)
43+ , HasContextEntry(getContextEntry)
44− -- ** NamedConfig
44+ -- ** NamedContext
45− , NamedConfig(..)
45+ , NamedContext(..)
46− , descendIntoNamedConfig
46+ , descendIntoNamedContext
47
47
48 -- * Default error type
48 -- * Default error type
49 , ServantErr(..)
49 , ServantErr(..)
@@ -113,11 +113,11 @@ import Servant.Server.Internal.Enter
113-- > main = Network.Wai.Handler.Warp.run 8080 app
113-- > main = Network.Wai.Handler.Warp.run 8080 app
114--
114--
115serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application
115serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application
116−serve p = serveWithConfig p EmptyConfig
116+serve p = serveWithContext p EmptyContext
117
117
118−serveWithConfig :: (HasServer layout config)
118+serveWithContext :: (HasServer layout context)
119− => Proxy layout -> Config config -> Server layout -> Application
119+ => Proxy layout -> Context context -> Server layout -> Application
120−serveWithConfig p config server = toApplication (runRouter (route p config d))
120+serveWithContext p context server = toApplication (runRouter (route p context d))
121 where
121 where
122 d = Delayed r r r (\ _ _ -> Route server)
122 d = Delayed r r r (\ _ _ -> Route server)
123 r = return (Route ())
123 r = return (Route ())
servant-server/src/Servant/Server/Internal.hs+58−58
@@ -15,7 +15,7 @@
15
15
16module Servant.Server.Internal
16module Servant.Server.Internal
17 ( module Servant.Server.Internal
17 ( module Servant.Server.Internal
18− , module Servant.Server.Internal.Config
18+ , module Servant.Server.Internal.Context
19 , module Servant.Server.Internal.Router
19 , module Servant.Server.Internal.Router
20 , module Servant.Server.Internal.RoutingApplication
20 , module Servant.Server.Internal.RoutingApplication
21 , module Servant.Server.Internal.ServantErr
21 , module Servant.Server.Internal.ServantErr
@@ -53,7 +53,7 @@ import Servant.API ((:<|>) (..), (:>), Capture,
53 IsSecure(..), Header,
53 IsSecure(..), Header,
54 QueryFlag, QueryParam, QueryParams,
54 QueryFlag, QueryParam, QueryParams,
55 Raw, RemoteHost, ReqBody, Vault,
55 Raw, RemoteHost, ReqBody, Vault,
56− WithNamedConfig)
56+ WithNamedContext)
57import Servant.API.ContentTypes (AcceptHeader (..),
57import Servant.API.ContentTypes (AcceptHeader (..),
58 AllCTRender (..),
58 AllCTRender (..),
59 AllCTUnrender (..),
59 AllCTUnrender (..),
@@ -62,16 +62,16 @@ import Servant.API.ContentTypes (AcceptHeader (..),
62import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
62import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
63 getResponse)
63 getResponse)
64
64
65−import Servant.Server.Internal.Config
65+import Servant.Server.Internal.Context
66import Servant.Server.Internal.Router
66import Servant.Server.Internal.Router
67import Servant.Server.Internal.RoutingApplication
67import Servant.Server.Internal.RoutingApplication
68import Servant.Server.Internal.ServantErr
68import Servant.Server.Internal.ServantErr
69
69
70
70
71−class HasServer layout config where
71+class HasServer layout context where
72 type ServerT layout (m :: * -> *) :: *
72 type ServerT layout (m :: * -> *) :: *
73
73
74− route :: Proxy layout -> Config config -> Delayed (Server layout) -> Router
74+ route :: Proxy layout -> Context context -> Delayed (Server layout) -> Router
75
75
76type Server layout = ServerT layout (ExceptT ServantErr IO)
76type Server layout = ServerT layout (ExceptT ServantErr IO)
77
77
@@ -88,12 +88,12 @@ type Server layout = ServerT layout (ExceptT ServantErr IO)
88-- > server = listAllBooks :<|> postBook
88-- > server = listAllBooks :<|> postBook
89-- > where listAllBooks = ...
89-- > where listAllBooks = ...
90-- > postBook book = ...
90-- > postBook book = ...
91−instance (HasServer a config, HasServer b config) => HasServer (a :<|> b) config where
91+instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) context where
92
92
93 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
93 type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
94
94
95− route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server))
95+ route Proxy context server = choice (route pa context ((\ (a :<|> _) -> a) <$> server))
96− (route pb config ((\ (_ :<|> b) -> b) <$> server))
96+ (route pb context ((\ (_ :<|> b) -> b) <$> server))
97 where pa = Proxy :: Proxy a
97 where pa = Proxy :: Proxy a
98 pb = Proxy :: Proxy b
98 pb = Proxy :: Proxy b
99
99
@@ -117,16 +117,16 @@ captured _ = parseUrlPieceMaybe
117-- > server = getBook
117-- > server = getBook
118-- > where getBook :: Text -> ExceptT ServantErr IO Book
118-- > where getBook :: Text -> ExceptT ServantErr IO Book
119-- > getBook isbn = ...
119-- > getBook isbn = ...
120−instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout config)
120+instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)
121− => HasServer (Capture capture a :> sublayout) config where
121+ => HasServer (Capture capture a :> sublayout) context where
122
122
123 type ServerT (Capture capture a :> sublayout) m =
123 type ServerT (Capture capture a :> sublayout) m =
124 a -> ServerT sublayout m
124 a -> ServerT sublayout m
125
125
126− route Proxy config d =
126+ route Proxy context d =
127 DynamicRouter $ \ first ->
127 DynamicRouter $ \ first ->
128 route (Proxy :: Proxy sublayout)
128 route (Proxy :: Proxy sublayout)
129− config
129+ context
130 (addCapture d $ case captured captureProxy first of
130 (addCapture d $ case captured captureProxy first of
131 Nothing -> return $ Fail err404
131 Nothing -> return $ Fail err404
132 Just v -> return $ Route v
132 Just v -> return $ Route v
@@ -195,7 +195,7 @@ methodRouterHeaders method proxy status action = LeafRouter route'
195
195
196instance OVERLAPPABLE_
196instance OVERLAPPABLE_
197 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
197 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
198− ) => HasServer (Verb method status ctypes a) config where
198+ ) => HasServer (Verb method status ctypes a) context where
199
199
200 type ServerT (Verb method status ctypes a) m = m a
200 type ServerT (Verb method status ctypes a) m = m a
201
201
@@ -206,7 +206,7 @@ instance OVERLAPPABLE_
206instance OVERLAPPING_
206instance OVERLAPPING_
207 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
207 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
208 , GetHeaders (Headers h a)
208 , GetHeaders (Headers h a)
209− ) => HasServer (Verb method status ctypes (Headers h a)) config where
209+ ) => HasServer (Verb method status ctypes (Headers h a)) context where
210
210
211 type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
211 type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
212
212
@@ -234,15 +234,15 @@ instance OVERLAPPING_
234-- > server = viewReferer
234-- > server = viewReferer
235-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
235-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
236-- > viewReferer referer = return referer
236-- > viewReferer referer = return referer
237−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
237+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
238− => HasServer (Header sym a :> sublayout) config where
238+ => HasServer (Header sym a :> sublayout) context where
239
239
240 type ServerT (Header sym a :> sublayout) m =
240 type ServerT (Header sym a :> sublayout) m =
241 Maybe a -> ServerT sublayout m
241 Maybe a -> ServerT sublayout m
242
242
243− route Proxy config subserver = WithRequest $ \ request ->
243+ route Proxy context subserver = WithRequest $ \ request ->
244 let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
244 let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
245− in route (Proxy :: Proxy sublayout) config (passToServer subserver mheader)
245+ in route (Proxy :: Proxy sublayout) context (passToServer subserver mheader)
246 where str = fromString $ symbolVal (Proxy :: Proxy sym)
246 where str = fromString $ symbolVal (Proxy :: Proxy sym)
247
247
248-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
248-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
@@ -266,13 +266,13 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
266-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
266-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
267-- > getBooksBy Nothing = ...return all books...
267-- > getBooksBy Nothing = ...return all books...
268-- > getBooksBy (Just author) = ...return books by the given author...
268-- > getBooksBy (Just author) = ...return books by the given author...
269−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
269+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
270− => HasServer (QueryParam sym a :> sublayout) config where
270+ => HasServer (QueryParam sym a :> sublayout) context where
271
271
272 type ServerT (QueryParam sym a :> sublayout) m =
272 type ServerT (QueryParam sym a :> sublayout) m =
273 Maybe a -> ServerT sublayout m
273 Maybe a -> ServerT sublayout m
274
274
275− route Proxy config subserver = WithRequest $ \ request ->
275+ route Proxy context subserver = WithRequest $ \ request ->
276 let querytext = parseQueryText $ rawQueryString request
276 let querytext = parseQueryText $ rawQueryString request
277 param =
277 param =
278 case lookup paramname querytext of
278 case lookup paramname querytext of
@@ -280,7 +280,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
280 Just Nothing -> Nothing -- param present with no value -> Nothing
280 Just Nothing -> Nothing -- param present with no value -> Nothing
281 Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
281 Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
282 -- the right type
282 -- the right type
283− in route (Proxy :: Proxy sublayout) config (passToServer subserver param)
283+ in route (Proxy :: Proxy sublayout) context (passToServer subserver param)
284 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
284 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
285
285
286-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
286-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@@ -302,20 +302,20 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
302-- > server = getBooksBy
302-- > server = getBooksBy
303-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
303-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
304-- > getBooksBy authors = ...return all books by these authors...
304-- > getBooksBy authors = ...return all books by these authors...
305−instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
305+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
306− => HasServer (QueryParams sym a :> sublayout) config where
306+ => HasServer (QueryParams sym a :> sublayout) context where
307
307
308 type ServerT (QueryParams sym a :> sublayout) m =
308 type ServerT (QueryParams sym a :> sublayout) m =
309 [a] -> ServerT sublayout m
309 [a] -> ServerT sublayout m
310
310
311− route Proxy config subserver = WithRequest $ \ request ->
311+ route Proxy context subserver = WithRequest $ \ request ->
312 let querytext = parseQueryText $ rawQueryString request
312 let querytext = parseQueryText $ rawQueryString request
313 -- if sym is "foo", we look for query string parameters
313 -- if sym is "foo", we look for query string parameters
314 -- named "foo" or "foo[]" and call parseQueryParam on the
314 -- named "foo" or "foo[]" and call parseQueryParam on the
315 -- corresponding values
315 -- corresponding values
316 parameters = filter looksLikeParam querytext
316 parameters = filter looksLikeParam querytext
317 values = mapMaybe (convert . snd) parameters
317 values = mapMaybe (convert . snd) parameters
318− in route (Proxy :: Proxy sublayout) config (passToServer subserver values)
318+ in route (Proxy :: Proxy sublayout) context (passToServer subserver values)
319 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
319 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
320 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
320 looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
321 convert Nothing = Nothing
321 convert Nothing = Nothing
@@ -333,19 +333,19 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
333-- > server = getBooks
333-- > server = getBooks
334-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
334-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
335-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
335-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
336−instance (KnownSymbol sym, HasServer sublayout config)
336+instance (KnownSymbol sym, HasServer sublayout context)
337− => HasServer (QueryFlag sym :> sublayout) config where
337+ => HasServer (QueryFlag sym :> sublayout) context where
338
338
339 type ServerT (QueryFlag sym :> sublayout) m =
339 type ServerT (QueryFlag sym :> sublayout) m =
340 Bool -> ServerT sublayout m
340 Bool -> ServerT sublayout m
341
341
342− route Proxy config subserver = WithRequest $ \ request ->
342+ route Proxy context subserver = WithRequest $ \ request ->
343 let querytext = parseQueryText $ rawQueryString request
343 let querytext = parseQueryText $ rawQueryString request
344 param = case lookup paramname querytext of
344 param = case lookup paramname querytext of
345 Just Nothing -> True -- param is there, with no value
345 Just Nothing -> True -- param is there, with no value
346 Just (Just v) -> examine v -- param with a value
346 Just (Just v) -> examine v -- param with a value
347 Nothing -> False -- param not in the query string
347 Nothing -> False -- param not in the query string
348− in route (Proxy :: Proxy sublayout) config (passToServer subserver param)
348+ in route (Proxy :: Proxy sublayout) context (passToServer subserver param)
349 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
349 where paramname = cs $ symbolVal (Proxy :: Proxy sym)
350 examine v | v == "true" || v == "1" || v == "" = True
350 examine v | v == "true" || v == "1" || v == "" = True
351 | otherwise = False
351 | otherwise = False
@@ -358,7 +358,7 @@ instance (KnownSymbol sym, HasServer sublayout config)
358-- >
358-- >
359-- > server :: Server MyApi
359-- > server :: Server MyApi
360-- > server = serveDirectory "/var/www/images"
360-- > server = serveDirectory "/var/www/images"
361−instance HasServer Raw config where
361+instance HasServer Raw context where
362
362
363 type ServerT Raw m = Application
363 type ServerT Raw m = Application
364
364
@@ -390,14 +390,14 @@ instance HasServer Raw config where
390-- > server = postBook
390-- > server = postBook
391-- > where postBook :: Book -> ExceptT ServantErr IO Book
391-- > where postBook :: Book -> ExceptT ServantErr IO Book
392-- > postBook book = ...insert into your db...
392-- > postBook book = ...insert into your db...
393−instance ( AllCTUnrender list a, HasServer sublayout config
393+instance ( AllCTUnrender list a, HasServer sublayout context
394− ) => HasServer (ReqBody list a :> sublayout) config where
394+ ) => HasServer (ReqBody list a :> sublayout) context where
395
395
396 type ServerT (ReqBody list a :> sublayout) m =
396 type ServerT (ReqBody list a :> sublayout) m =
397 a -> ServerT sublayout m
397 a -> ServerT sublayout m
398
398
399− route Proxy config subserver = WithRequest $ \ request ->
399+ route Proxy context subserver = WithRequest $ \ request ->
400− route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request))
400+ route (Proxy :: Proxy sublayout) context (addBodyCheck subserver (bodyCheck request))
401 where
401 where
402 bodyCheck request = do
402 bodyCheck request = do
403 -- See HTTP RFC 2616, section 7.2.1
403 -- See HTTP RFC 2616, section 7.2.1
@@ -415,40 +415,40 @@ instance ( AllCTUnrender list a, HasServer sublayout config
415
415
416-- | Make sure the incoming request starts with @"/path"@, strip it and
416-- | Make sure the incoming request starts with @"/path"@, strip it and
417-- pass the rest of the request path to @sublayout@.
417-- pass the rest of the request path to @sublayout@.
418−instance (KnownSymbol path, HasServer sublayout config) => HasServer (path :> sublayout) config where
418+instance (KnownSymbol path, HasServer sublayout context) => HasServer (path :> sublayout) context where
419
419
420 type ServerT (path :> sublayout) m = ServerT sublayout m
420 type ServerT (path :> sublayout) m = ServerT sublayout m
421
421
422− route Proxy config subserver = StaticRouter $
422+ route Proxy context subserver = StaticRouter $
423 M.singleton (cs (symbolVal proxyPath))
423 M.singleton (cs (symbolVal proxyPath))
424− (route (Proxy :: Proxy sublayout) config subserver)
424+ (route (Proxy :: Proxy sublayout) context subserver)
425 where proxyPath = Proxy :: Proxy path
425 where proxyPath = Proxy :: Proxy path
426
426
427−instance HasServer api config => HasServer (RemoteHost :> api) config where
427+instance HasServer api context => HasServer (RemoteHost :> api) context where
428 type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
428 type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
429
429
430− route Proxy config subserver = WithRequest $ \req ->
430+ route Proxy context subserver = WithRequest $ \req ->
431− route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req)
431+ route (Proxy :: Proxy api) context (passToServer subserver $ remoteHost req)
432
432
433−instance HasServer api config => HasServer (IsSecure :> api) config where
433+instance HasServer api context => HasServer (IsSecure :> api) context where
434 type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
434 type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
435
435
436− route Proxy config subserver = WithRequest $ \req ->
436+ route Proxy context subserver = WithRequest $ \req ->
437− route (Proxy :: Proxy api) config (passToServer subserver $ secure req)
437+ route (Proxy :: Proxy api) context (passToServer subserver $ secure req)
438
438
439 where secure req = if isSecure req then Secure else NotSecure
439 where secure req = if isSecure req then Secure else NotSecure
440
440
441−instance HasServer api config => HasServer (Vault :> api) config where
441+instance HasServer api context => HasServer (Vault :> api) context where
442 type ServerT (Vault :> api) m = Vault -> ServerT api m
442 type ServerT (Vault :> api) m = Vault -> ServerT api m
443
443
444− route Proxy config subserver = WithRequest $ \req ->
444+ route Proxy context subserver = WithRequest $ \req ->
445− route (Proxy :: Proxy api) config (passToServer subserver $ vault req)
445+ route (Proxy :: Proxy api) context (passToServer subserver $ vault req)
446
446
447−instance HasServer api config => HasServer (HttpVersion :> api) config where
447+instance HasServer api context => HasServer (HttpVersion :> api) context where
448 type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
448 type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
449
449
450− route Proxy config subserver = WithRequest $ \req ->
450+ route Proxy context subserver = WithRequest $ \req ->
451− route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req)
451+ route (Proxy :: Proxy api) context (passToServer subserver $ httpVersion req)
452
452
453pathIsEmpty :: Request -> Bool
453pathIsEmpty :: Request -> Bool
454pathIsEmpty = go . pathInfo
454pathIsEmpty = go . pathInfo
@@ -459,19 +459,19 @@ pathIsEmpty = go . pathInfo
459ct_wildcard :: B.ByteString
459ct_wildcard :: B.ByteString
460ct_wildcard = "*" <> "/" <> "*" -- Because CPP
460ct_wildcard = "*" <> "/" <> "*" -- Because CPP
461
461
462−-- * configs
462+-- * contexts
463
463
464−instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig)
464+instance (HasContextEntry context (NamedContext name subContext), HasServer subApi subContext)
465− => HasServer (WithNamedConfig name subConfig subApi) config where
465+ => HasServer (WithNamedContext name subContext subApi) context where
466
466
467− type ServerT (WithNamedConfig name subConfig subApi) m =
467+ type ServerT (WithNamedContext name subContext subApi) m =
468 ServerT subApi m
468 ServerT subApi m
469
469
470− route Proxy config delayed =
470+ route Proxy context delayed =
471− route subProxy subConfig delayed
471+ route subProxy subContext delayed
472 where
472 where
473 subProxy :: Proxy subApi
473 subProxy :: Proxy subApi
474 subProxy = Proxy
474 subProxy = Proxy
475
475
476− subConfig :: Config subConfig
476+ subContext :: Context subContext
477− subConfig = descendIntoNamedConfig (Proxy :: Proxy name) config
477+ subContext = descendIntoNamedContext (Proxy :: Proxy name) context
servant-server/src/Servant/Server/Internal/Config.hsdeleted−99
@@ -1,99 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE KindSignatures #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TypeOperators #-}
10−
11−#include "overlapping-compat.h"
12−
13−module Servant.Server.Internal.Config where
14−
15−import Data.Proxy
16−import GHC.TypeLits
17−
18−-- | When calling 'Servant.Server.serve' you have to supply a configuration
19−-- value of type @'Config' configTypes@. This parameter is used to pass values
20−-- to combinators. (It shouldn't be confused with general configuration
21−-- parameters for your web app, like the port, etc.). If you don't use
22−-- combinators that require any config entries, you can just pass 'EmptyConfig'.
23−-- To create a config with entries, use the operator @(':.')@. The parameter of
24−-- the type 'Config' is a type-level list reflecting the types of the contained
25−-- config entries:
26−--
27−-- >>> :type True :. () :. EmptyConfig
28−-- True :. () :. EmptyConfig :: Config '[Bool, ()]
29−data Config configTypes where
30− EmptyConfig :: Config '[]
31− (:.) :: x -> Config xs -> Config (x ': xs)
32−infixr 5 :.
33−
34−instance Show (Config '[]) where
35− show EmptyConfig = "EmptyConfig"
36−instance (Show a, Show (Config as)) => Show (Config (a ': as)) where
37− showsPrec outerPrecedence (a :. as) =
38− showParen (outerPrecedence > 5) $
39− shows a . showString " :. " . shows as
40−
41−instance Eq (Config '[]) where
42− _ == _ = True
43−instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
44− x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
45−
46−-- | This class is used to access config entries in 'Config's. 'getConfigEntry'
47−-- returns the first value where the type matches:
48−--
49−-- >>> getConfigEntry (True :. False :. EmptyConfig) :: Bool
50−-- True
51−--
52−-- If the 'Config' does not contain an entry of the requested type, you'll get
53−-- an error:
54−--
55−-- >>> getConfigEntry (True :. False :. EmptyConfig) :: String
56−-- ...
57−-- No instance for (HasConfigEntry '[] [Char])
58−-- ...
59−class HasConfigEntry (config :: [*]) (val :: *) where
60− getConfigEntry :: Config config -> val
61−
62−instance OVERLAPPABLE_
63− HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where
64− getConfigEntry (_ :. xs) = getConfigEntry xs
65−
66−instance OVERLAPPING_
67− HasConfigEntry (val ': xs) val where
68− getConfigEntry (x :. _) = x
69−
70−-- * support for named subconfigs
71−
72−-- | Normally config entries are accessed by their types. In case you need
73−-- to have multiple values of the same type in your 'Config' and need to access
74−-- them, we provide 'NamedConfig'. You can think of it as sub-namespaces for
75−-- 'Config's.
76−data NamedConfig (name :: Symbol) (subConfig :: [*])
77− = NamedConfig (Config subConfig)
78−
79−-- | 'descendIntoNamedConfig' allows you to access `NamedConfig's. Usually you
80−-- won't have to use it yourself but instead use a combinator like
81−-- 'Servant.API.WithNamedConfig.WithNamedConfig'.
82−--
83−-- This is how 'descendIntoNamedConfig' works:
84−--
85−-- >>> :set -XFlexibleContexts
86−-- >>> let subConfig = True :. EmptyConfig
87−-- >>> :type subConfig
88−-- subConfig :: Config '[Bool]
89−-- >>> let parentConfig = False :. (NamedConfig subConfig :: NamedConfig "subConfig" '[Bool]) :. EmptyConfig
90−-- >>> :type parentConfig
91−-- parentConfig :: Config '[Bool, NamedConfig "subConfig" '[Bool]]
92−-- >>> descendIntoNamedConfig (Proxy :: Proxy "subConfig") parentConfig :: Config '[Bool]
93−-- True :. EmptyConfig
94−descendIntoNamedConfig :: forall config name subConfig .
95− HasConfigEntry config (NamedConfig name subConfig) =>
96− Proxy (name :: Symbol) -> Config config -> Config subConfig
97−descendIntoNamedConfig Proxy config =
98− let NamedConfig subConfig = getConfigEntry config :: NamedConfig name subConfig
99− in subConfig
servant-server/src/Servant/Server/Internal/Context.hsnew file+99
@@ -0,0 +1,99 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE KindSignatures #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE TypeOperators #-}
10+
11+#include "overlapping-compat.h"
12+
13+module Servant.Server.Internal.Context where
14+
15+import Data.Proxy
16+import GHC.TypeLits
17+
18+-- | When calling 'Servant.Server.serve' you have to supply a context
19+-- value of type @'Context' contextTypes@. This parameter is used to pass values
20+-- to combinators. (It shouldn't be confused with general configuration
21+-- parameters for your web app, like the port, etc.). If you don't use
22+-- combinators that require any context entries, you can just use `serve` (or
23+-- pass 'EmptyContext'). To create a context with entries, use the operator
24+-- @(':.')@. The parameter of the type 'Context' is a type-level list reflecting
25+-- the types of the contained context entries:
26+--
27+-- >>> :type True :. () :. EmptyContext
28+-- True :. () :. EmptyContext :: Context '[Bool, ()]
29+data Context contextTypes where
30+ EmptyContext :: Context '[]
31+ (:.) :: x -> Context xs -> Context (x ': xs)
32+infixr 5 :.
33+
34+instance Show (Context '[]) where
35+ show EmptyContext = "EmptyContext"
36+instance (Show a, Show (Context as)) => Show (Context (a ': as)) where
37+ showsPrec outerPrecedence (a :. as) =
38+ showParen (outerPrecedence > 5) $
39+ shows a . showString " :. " . shows as
40+
41+instance Eq (Context '[]) where
42+ _ == _ = True
43+instance (Eq a, Eq (Context as)) => Eq (Context (a ': as)) where
44+ x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
45+
46+-- | This class is used to access context entries in 'Context's. 'getContextEntry'
47+-- returns the first value where the type matches:
48+--
49+-- >>> getContextEntry (True :. False :. EmptyContext) :: Bool
50+-- True
51+--
52+-- If the 'Context' does not contain an entry of the requested type, you'll get
53+-- an error:
54+--
55+-- >>> getContextEntry (True :. False :. EmptyContext) :: String
56+-- ...
57+-- No instance for (HasContextEntry '[] [Char])
58+-- ...
59+class HasContextEntry (context :: [*]) (val :: *) where
60+ getContextEntry :: Context context -> val
61+
62+instance OVERLAPPABLE_
63+ HasContextEntry xs val => HasContextEntry (notIt ': xs) val where
64+ getContextEntry (_ :. xs) = getContextEntry xs
65+
66+instance OVERLAPPING_
67+ HasContextEntry (val ': xs) val where
68+ getContextEntry (x :. _) = x
69+
70+-- * support for named subcontexts
71+
72+-- | Normally context entries are accessed by their types. In case you need
73+-- to have multiple values of the same type in your 'Context' and need to access
74+-- them, we provide 'NamedContext'. You can think of it as sub-namespaces for
75+-- 'Context's.
76+data NamedContext (name :: Symbol) (subContext :: [*])
77+ = NamedContext (Context subContext)
78+
79+-- | 'descendIntoNamedContext' allows you to access `NamedContext's. Usually you
80+-- won't have to use it yourself but instead use a combinator like
81+-- 'Servant.API.WithNamedContext.WithNamedContext'.
82+--
83+-- This is how 'descendIntoNamedContext' works:
84+--
85+-- >>> :set -XFlexibleContexts
86+-- >>> let subContext = True :. EmptyContext
87+-- >>> :type subContext
88+-- subContext :: Context '[Bool]
89+-- >>> let parentContext = False :. (NamedContext subContext :: NamedContext "subContext" '[Bool]) :. EmptyContext
90+-- >>> :type parentContext
91+-- parentContext :: Context '[Bool, NamedContext "subContext" '[Bool]]
92+-- >>> descendIntoNamedContext (Proxy :: Proxy "subContext") parentContext :: Context '[Bool]
93+-- True :. EmptyContext
94+descendIntoNamedContext :: forall context name subContext .
95+ HasContextEntry context (NamedContext name subContext) =>
96+ Proxy (name :: Symbol) -> Context context -> Context subContext
97+descendIntoNamedContext Proxy context =
98+ let NamedContext subContext = getContextEntry context :: NamedContext name subContext
99+ in subContext
servant-server/test/Servant/Server/Internal/ConfigSpec.hsdeleted−61
@@ -1,61 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# OPTIONS_GHC -fdefer-type-errors #-}
3−module Servant.Server.Internal.ConfigSpec (spec) where
4−
5−import Data.Proxy (Proxy (..))
6−import Test.Hspec (Spec, describe, it, shouldBe, pending, context)
7−import Test.ShouldNotTypecheck (shouldNotTypecheck)
8−
9−import Servant.API
10−import Servant.Server.Internal.Config
11−
12−spec :: Spec
13−spec = do
14− describe "getConfigEntry" $ do
15− it "gets the config if a matching one exists" $ do
16− let config = 'a' :. EmptyConfig
17− getConfigEntry config `shouldBe` 'a'
18−
19− it "gets the first matching config" $ do
20− let config = 'a' :. 'b' :. EmptyConfig
21− getConfigEntry config `shouldBe` 'a'
22−
23− it "does not typecheck if type does not exist" $ do
24− let config = 'a' :. EmptyConfig
25− x = getConfigEntry config :: Bool
26− shouldNotTypecheck x
27−
28− context "Show instance" $ do
29− let config = 'a' :. True :. EmptyConfig
30− it "has a Show instance" $ do
31− show config `shouldBe` "'a' :. True :. EmptyConfig"
32−
33− context "bracketing" $ do
34− it "works" $ do
35− show (Just config) `shouldBe` "Just ('a' :. True :. EmptyConfig)"
36−
37− it "works with operators" $ do
38− let config = (1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)
39− show config `shouldBe` "(1 :. 'a' :. EmptyConfig) :<|> ('b' :. True :. EmptyConfig)"
40−
41− describe "descendIntoNamedConfig" $ do
42− let config :: Config [Char, NamedConfig "sub" '[Char]]
43− config =
44− 'a' :.
45− (NamedConfig subConfig :: NamedConfig "sub" '[Char])
46− :. EmptyConfig
47− subConfig = 'b' :. EmptyConfig
48− it "allows extracting subconfigs" $ do
49− descendIntoNamedConfig (Proxy :: Proxy "sub") config `shouldBe` subConfig
50−
51− it "allows extracting entries from subconfigs" $ do
52− getConfigEntry (descendIntoNamedConfig (Proxy :: Proxy "sub") config :: Config '[Char])
53− `shouldBe` 'b'
54−
55− it "does not typecheck if subConfig has the wrong type" $ do
56− let x = descendIntoNamedConfig (Proxy :: Proxy "sub") config :: Config '[Int]
57− shouldNotTypecheck (show x)
58−
59− it "does not typecheck if subConfig with that name doesn't exist" $ do
60− let x = descendIntoNamedConfig (Proxy :: Proxy "foo") config :: Config '[Char]
61− shouldNotTypecheck (show x)
servant-server/test/Servant/Server/Internal/ContextSpec.hsnew file+61
@@ -0,0 +1,61 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# OPTIONS_GHC -fdefer-type-errors #-}
3+module Servant.Server.Internal.ContextSpec (spec) where
4+
5+import Data.Proxy (Proxy (..))
6+import Test.Hspec (Spec, describe, it, shouldBe, pending, context)
7+import Test.ShouldNotTypecheck (shouldNotTypecheck)
8+
9+import Servant.API
10+import Servant.Server.Internal.Context
11+
12+spec :: Spec
13+spec = do
14+ describe "getContextEntry" $ do
15+ it "gets the context if a matching one exists" $ do
16+ let cxt = 'a' :. EmptyContext
17+ getContextEntry cxt `shouldBe` 'a'
18+
19+ it "gets the first matching context" $ do
20+ let cxt = 'a' :. 'b' :. EmptyContext
21+ getContextEntry cxt `shouldBe` 'a'
22+
23+ it "does not typecheck if type does not exist" $ do
24+ let cxt = 'a' :. EmptyContext
25+ x = getContextEntry cxt :: Bool
26+ shouldNotTypecheck x
27+
28+ context "Show instance" $ do
29+ let cxt = 'a' :. True :. EmptyContext
30+ it "has a Show instance" $ do
31+ show cxt `shouldBe` "'a' :. True :. EmptyContext"
32+
33+ context "bracketing" $ do
34+ it "works" $ do
35+ show (Just cxt) `shouldBe` "Just ('a' :. True :. EmptyContext)"
36+
37+ it "works with operators" $ do
38+ let cxt = (1 :. 'a' :. EmptyContext) :<|> ('b' :. True :. EmptyContext)
39+ show cxt `shouldBe` "(1 :. 'a' :. EmptyContext) :<|> ('b' :. True :. EmptyContext)"
40+
41+ describe "descendIntoNamedContext" $ do
42+ let cxt :: Context [Char, NamedContext "sub" '[Char]]
43+ cxt =
44+ 'a' :.
45+ (NamedContext subContext :: NamedContext "sub" '[Char])
46+ :. EmptyContext
47+ subContext = 'b' :. EmptyContext
48+ it "allows extracting subcontexts" $ do
49+ descendIntoNamedContext (Proxy :: Proxy "sub") cxt `shouldBe` subContext
50+
51+ it "allows extracting entries from subcontexts" $ do
52+ getContextEntry (descendIntoNamedContext (Proxy :: Proxy "sub") cxt :: Context '[Char])
53+ `shouldBe` 'b'
54+
55+ it "does not typecheck if subContext has the wrong type" $ do
56+ let x = descendIntoNamedContext (Proxy :: Proxy "sub") cxt :: Context '[Int]
57+ shouldNotTypecheck (show x)
58+
59+ it "does not typecheck if subContext with that name doesn't exist" $ do
60+ let x = descendIntoNamedContext (Proxy :: Proxy "foo") cxt :: Context '[Char]
61+ shouldNotTypecheck (show x)
servant-server/test/Servant/Server/UsingConfigSpec.hsdeleted−125
@@ -1,125 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeOperators #-}
5−
6−module Servant.Server.UsingConfigSpec where
7−
8−import Control.Monad.Trans.Except
9−import Network.Wai
10−import Test.Hspec (Spec, describe, it)
11−import Test.Hspec.Wai
12−
13−import Servant
14−import Servant.Server.UsingConfigSpec.TestCombinators
15−
16−spec :: Spec
17−spec = do
18− spec1
19− spec2
20− spec3
21− spec4
22−
23−-- * API
24−
25−type OneEntryAPI =
26− ExtractFromConfig :> Get '[JSON] String
27−
28−testServer :: String -> ExceptT ServantErr IO String
29−testServer s = return s
30−
31−oneEntryApp :: Application
32−oneEntryApp =
33− serveWithConfig (Proxy :: Proxy OneEntryAPI) config testServer
34− where
35− config :: Config '[String]
36− config = "configEntry" :. EmptyConfig
37−
38−type OneEntryTwiceAPI =
39− "foo" :> ExtractFromConfig :> Get '[JSON] String :<|>
40− "bar" :> ExtractFromConfig :> Get '[JSON] String
41−
42−oneEntryTwiceApp :: Application
43−oneEntryTwiceApp = serveWithConfig (Proxy :: Proxy OneEntryTwiceAPI) config $
44− testServer :<|>
45− testServer
46− where
47− config :: Config '[String]
48− config = "configEntryTwice" :. EmptyConfig
49−
50−-- * tests
51−
52−spec1 :: Spec
53−spec1 = do
54− describe "accessing config entries from custom combinators" $ do
55− with (return oneEntryApp) $ do
56− it "allows retrieving a ConfigEntry" $ do
57− get "/" `shouldRespondWith` "\"configEntry\""
58−
59− with (return oneEntryTwiceApp) $ do
60− it "allows retrieving the same ConfigEntry twice" $ do
61− get "/foo" `shouldRespondWith` "\"configEntryTwice\""
62− get "/bar" `shouldRespondWith` "\"configEntryTwice\""
63−
64−type InjectAPI =
65− InjectIntoConfig :> "untagged" :> ExtractFromConfig :>
66− Get '[JSON] String :<|>
67− InjectIntoConfig :> "tagged" :> ExtractFromConfig :>
68− Get '[JSON] String
69−
70−injectApp :: Application
71−injectApp = serveWithConfig (Proxy :: Proxy InjectAPI) config $
72− (\ s -> return s) :<|>
73− (\ s -> return ("tagged: " ++ s))
74− where
75− config = EmptyConfig
76−
77−spec2 :: Spec
78−spec2 = do
79− with (return injectApp) $ do
80− describe "inserting config entries with custom combinators" $ do
81− it "allows to inject config entries" $ do
82− get "/untagged" `shouldRespondWith` "\"injected\""
83−
84− it "allows to inject tagged config entries" $ do
85− get "/tagged" `shouldRespondWith` "\"tagged: injected\""
86−
87−type WithBirdfaceAPI =
88− "foo" :> ExtractFromConfig :> Get '[JSON] String :<|>
89− NamedConfigWithBirdface "sub" '[String] :>
90− "bar" :> ExtractFromConfig :> Get '[JSON] String
91−
92−withBirdfaceApp :: Application
93−withBirdfaceApp = serveWithConfig (Proxy :: Proxy WithBirdfaceAPI) config $
94− testServer :<|>
95− testServer
96− where
97− config :: Config '[String, (NamedConfig "sub" '[String])]
98− config =
99− "firstEntry" :.
100− (NamedConfig ("secondEntry" :. EmptyConfig)) :.
101− EmptyConfig
102−
103−spec3 :: Spec
104−spec3 = do
105− with (return withBirdfaceApp) $ do
106− it "allows retrieving different ConfigEntries for the same combinator" $ do
107− get "/foo" `shouldRespondWith` "\"firstEntry\""
108− get "/bar" `shouldRespondWith` "\"secondEntry\""
109−
110−type NamedConfigAPI =
111− WithNamedConfig "sub" '[String] (
112− ExtractFromConfig :> Get '[JSON] String)
113−
114−namedConfigApp :: Application
115−namedConfigApp = serveWithConfig (Proxy :: Proxy NamedConfigAPI) config return
116− where
117− config :: Config '[NamedConfig "sub" '[String]]
118− config = NamedConfig ("descend" :. EmptyConfig) :. EmptyConfig
119−
120−spec4 :: Spec
121−spec4 = do
122− with (return namedConfigApp) $ do
123− describe "WithNamedConfig" $ do
124− it "allows descending into a subconfig for a given api" $ do
125− get "/" `shouldRespondWith` "\"descend\""
servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE KindSignatures #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE PolyKinds #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE TypeOperators #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−
12−-- | These are custom combinators for Servant.Server.UsingConfigSpec.
13−--
14−-- (For writing your own combinators you need to import Internal modules, for
15−-- just *using* combinators that require a Config, you don't. This module is
16−-- separate from Servant.Server.UsingConfigSpec to test that the module imports
17−-- work out this way.)
18−module Servant.Server.UsingConfigSpec.TestCombinators where
19−
20−import GHC.TypeLits
21−
22−import Servant
23−import Servant.Server.Internal.Config
24−import Servant.Server.Internal.RoutingApplication
25−
26−data ExtractFromConfig
27−
28−instance (HasConfigEntry config String, HasServer subApi config) =>
29− HasServer (ExtractFromConfig :> subApi) config where
30−
31− type ServerT (ExtractFromConfig :> subApi) m =
32− String -> ServerT subApi m
33−
34− route Proxy config delayed =
35− route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
36− where
37− subProxy :: Proxy subApi
38− subProxy = Proxy
39−
40− inject config f = f (getConfigEntry config)
41−
42−data InjectIntoConfig
43−
44−instance (HasServer subApi (String ': config)) =>
45− HasServer (InjectIntoConfig :> subApi) config where
46−
47− type ServerT (InjectIntoConfig :> subApi) m =
48− ServerT subApi m
49−
50− route Proxy config delayed =
51− route subProxy newConfig delayed
52− where
53− subProxy :: Proxy subApi
54− subProxy = Proxy
55−
56− newConfig = ("injected" :: String) :. config
57−
58−data NamedConfigWithBirdface (name :: Symbol) (subConfig :: [*])
59−
60−instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig) =>
61− HasServer (NamedConfigWithBirdface name subConfig :> subApi) config where
62−
63− type ServerT (NamedConfigWithBirdface name subConfig :> subApi) m =
64− ServerT subApi m
65−
66− route Proxy config delayed =
67− route subProxy subConfig delayed
68− where
69− subProxy :: Proxy subApi
70− subProxy = Proxy
71−
72− subConfig :: Config subConfig
73− subConfig = descendIntoNamedConfig (Proxy :: Proxy name) config
servant-server/test/Servant/Server/UsingContextSpec.hsnew file+125
@@ -0,0 +1,125 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE TypeOperators #-}
5+
6+module Servant.Server.UsingContextSpec where
7+
8+import Control.Monad.Trans.Except
9+import Network.Wai
10+import Test.Hspec (Spec, describe, it)
11+import Test.Hspec.Wai
12+
13+import Servant
14+import Servant.Server.UsingContextSpec.TestCombinators
15+
16+spec :: Spec
17+spec = do
18+ spec1
19+ spec2
20+ spec3
21+ spec4
22+
23+-- * API
24+
25+type OneEntryAPI =
26+ ExtractFromContext :> Get '[JSON] String
27+
28+testServer :: String -> ExceptT ServantErr IO String
29+testServer s = return s
30+
31+oneEntryApp :: Application
32+oneEntryApp =
33+ serveWithContext (Proxy :: Proxy OneEntryAPI) context testServer
34+ where
35+ context :: Context '[String]
36+ context = "contextEntry" :. EmptyContext
37+
38+type OneEntryTwiceAPI =
39+ "foo" :> ExtractFromContext :> Get '[JSON] String :<|>
40+ "bar" :> ExtractFromContext :> Get '[JSON] String
41+
42+oneEntryTwiceApp :: Application
43+oneEntryTwiceApp = serveWithContext (Proxy :: Proxy OneEntryTwiceAPI) context $
44+ testServer :<|>
45+ testServer
46+ where
47+ context :: Context '[String]
48+ context = "contextEntryTwice" :. EmptyContext
49+
50+-- * tests
51+
52+spec1 :: Spec
53+spec1 = do
54+ describe "accessing context entries from custom combinators" $ do
55+ with (return oneEntryApp) $ do
56+ it "allows retrieving a ContextEntry" $ do
57+ get "/" `shouldRespondWith` "\"contextEntry\""
58+
59+ with (return oneEntryTwiceApp) $ do
60+ it "allows retrieving the same ContextEntry twice" $ do
61+ get "/foo" `shouldRespondWith` "\"contextEntryTwice\""
62+ get "/bar" `shouldRespondWith` "\"contextEntryTwice\""
63+
64+type InjectAPI =
65+ InjectIntoContext :> "untagged" :> ExtractFromContext :>
66+ Get '[JSON] String :<|>
67+ InjectIntoContext :> "tagged" :> ExtractFromContext :>
68+ Get '[JSON] String
69+
70+injectApp :: Application
71+injectApp = serveWithContext (Proxy :: Proxy InjectAPI) context $
72+ (\ s -> return s) :<|>
73+ (\ s -> return ("tagged: " ++ s))
74+ where
75+ context = EmptyContext
76+
77+spec2 :: Spec
78+spec2 = do
79+ with (return injectApp) $ do
80+ describe "inserting context entries with custom combinators" $ do
81+ it "allows to inject context entries" $ do
82+ get "/untagged" `shouldRespondWith` "\"injected\""
83+
84+ it "allows to inject tagged context entries" $ do
85+ get "/tagged" `shouldRespondWith` "\"tagged: injected\""
86+
87+type WithBirdfaceAPI =
88+ "foo" :> ExtractFromContext :> Get '[JSON] String :<|>
89+ NamedContextWithBirdface "sub" '[String] :>
90+ "bar" :> ExtractFromContext :> Get '[JSON] String
91+
92+withBirdfaceApp :: Application
93+withBirdfaceApp = serveWithContext (Proxy :: Proxy WithBirdfaceAPI) context $
94+ testServer :<|>
95+ testServer
96+ where
97+ context :: Context '[String, (NamedContext "sub" '[String])]
98+ context =
99+ "firstEntry" :.
100+ (NamedContext ("secondEntry" :. EmptyContext)) :.
101+ EmptyContext
102+
103+spec3 :: Spec
104+spec3 = do
105+ with (return withBirdfaceApp) $ do
106+ it "allows retrieving different ContextEntries for the same combinator" $ do
107+ get "/foo" `shouldRespondWith` "\"firstEntry\""
108+ get "/bar" `shouldRespondWith` "\"secondEntry\""
109+
110+type NamedContextAPI =
111+ WithNamedContext "sub" '[String] (
112+ ExtractFromContext :> Get '[JSON] String)
113+
114+namedContextApp :: Application
115+namedContextApp = serveWithContext (Proxy :: Proxy NamedContextAPI) context return
116+ where
117+ context :: Context '[NamedContext "sub" '[String]]
118+ context = NamedContext ("descend" :. EmptyContext) :. EmptyContext
119+
120+spec4 :: Spec
121+spec4 = do
122+ with (return namedContextApp) $ do
123+ describe "WithNamedContext" $ do
124+ it "allows descending into a subcontext for a given api" $ do
125+ get "/" `shouldRespondWith` "\"descend\""
servant-server/test/Servant/Server/UsingContextSpec/TestCombinators.hsnew file+72
@@ -0,0 +1,72 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE PolyKinds #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE UndecidableInstances #-}
11+
12+-- | These are custom combinators for Servant.Server.UsingContextSpec.
13+--
14+-- (For writing your own combinators you need to import Internal modules, for
15+-- just *using* combinators that require a Context, you don't. This module is
16+-- separate from Servant.Server.UsingContextSpec to test that the module imports
17+-- work out this way.)
18+module Servant.Server.UsingContextSpec.TestCombinators where
19+
20+import GHC.TypeLits
21+
22+import Servant
23+import Servant.Server.Internal.RoutingApplication
24+
25+data ExtractFromContext
26+
27+instance (HasContextEntry context String, HasServer subApi context) =>
28+ HasServer (ExtractFromContext :> subApi) context where
29+
30+ type ServerT (ExtractFromContext :> subApi) m =
31+ String -> ServerT subApi m
32+
33+ route Proxy context delayed =
34+ route subProxy context (fmap (inject context) delayed :: Delayed (Server subApi))
35+ where
36+ subProxy :: Proxy subApi
37+ subProxy = Proxy
38+
39+ inject context f = f (getContextEntry context)
40+
41+data InjectIntoContext
42+
43+instance (HasServer subApi (String ': context)) =>
44+ HasServer (InjectIntoContext :> subApi) context where
45+
46+ type ServerT (InjectIntoContext :> subApi) m =
47+ ServerT subApi m
48+
49+ route Proxy context delayed =
50+ route subProxy newContext delayed
51+ where
52+ subProxy :: Proxy subApi
53+ subProxy = Proxy
54+
55+ newContext = ("injected" :: String) :. context
56+
57+data NamedContextWithBirdface (name :: Symbol) (subContext :: [*])
58+
59+instance (HasContextEntry context (NamedContext name subContext), HasServer subApi subContext) =>
60+ HasServer (NamedContextWithBirdface name subContext :> subApi) context where
61+
62+ type ServerT (NamedContextWithBirdface name subContext :> subApi) m =
63+ ServerT subApi m
64+
65+ route Proxy context delayed =
66+ route subProxy subContext delayed
67+ where
68+ subProxy :: Proxy subApi
69+ subProxy = Proxy
70+
71+ subContext :: Context subContext
72+ subContext = descendIntoNamedContext (Proxy :: Proxy name) context
servant-server/test/Servant/ServerSpec.hs+6−6
@@ -49,7 +49,7 @@ import Servant.API ((:<|>) (..), (:>), Capture, Delete,
49 StdMethod (..), Verb, addHeader)
49 StdMethod (..), Verb, addHeader)
50import Servant.API.Internal.Test.ComprehensiveAPI
50import Servant.API.Internal.Test.ComprehensiveAPI
51import Servant.Server (ServantErr (..), Server, err404,
51import Servant.Server (ServantErr (..), Server, err404,
52− serve, serveWithConfig, Config(EmptyConfig))
52+ serve, serveWithContext, Context(EmptyContext))
53import Test.Hspec (Spec, context, describe, it,
53import Test.Hspec (Spec, context, describe, it,
54 shouldBe, shouldContain)
54 shouldBe, shouldContain)
55import Test.Hspec.Wai (get, liftIO, matchHeaders,
55import Test.Hspec.Wai (get, liftIO, matchHeaders,
@@ -61,16 +61,16 @@ import Servant.Server.Internal.RoutingApplication
61import Servant.Server.Internal.Router
61import Servant.Server.Internal.Router
62 (tweakResponse, runRouter,
62 (tweakResponse, runRouter,
63 Router, Router'(LeafRouter))
63 Router, Router'(LeafRouter))
64−import Servant.Server.Internal.Config
64+import Servant.Server.Internal.Context
65− (Config(..), NamedConfig(..))
65+ (Context(..), NamedContext(..))
66
66
67-- * comprehensive api test
67-- * comprehensive api test
68
68
69-- This declaration simply checks that all instances are in place.
69-- This declaration simply checks that all instances are in place.
70−_ = serveWithConfig comprehensiveAPI comprehensiveApiConfig
70+_ = serveWithContext comprehensiveAPI comprehensiveApiContext
71
71
72−comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]]
72+comprehensiveApiContext :: Context '[NamedContext "foo" '[]]
73−comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig
73+comprehensiveApiContext = NamedContext EmptyContext :. EmptyContext
74
74
75-- * Specs
75-- * Specs
76
76
servant/servant.cabal+1−1
@@ -41,7 +41,7 @@ library
41 Servant.API.Sub
41 Servant.API.Sub
42 Servant.API.Vault
42 Servant.API.Vault
43 Servant.API.Verbs
43 Servant.API.Verbs
44− Servant.API.WithNamedConfig
44+ Servant.API.WithNamedContext
45 Servant.Utils.Links
45 Servant.Utils.Links
46 build-depends:
46 build-depends:
47 base >=4.7 && <5
47 base >=4.7 && <5
servant/src/Servant/API.hs+3−3
@@ -23,8 +23,8 @@ module Servant.API (
23 -- | Is the request made through HTTPS?
23 -- | Is the request made through HTTPS?
24 module Servant.API.Vault,
24 module Servant.API.Vault,
25 -- | Access the location for arbitrary data to be shared by applications and middleware
25 -- | Access the location for arbitrary data to be shared by applications and middleware
26− module Servant.API.WithNamedConfig,
26+ module Servant.API.WithNamedContext,
27− -- | Access config entries in combinators in servant-server
27+ -- | Access context entries in combinators in servant-server
28
28
29 -- * Actual endpoints, distinguished by HTTP method
29 -- * Actual endpoints, distinguished by HTTP method
30 module Servant.API.Verbs,
30 module Servant.API.Verbs,
@@ -90,7 +90,7 @@ import Servant.API.Verbs (PostCreated, Delete, DeleteAccepte
90 PutNoContent, PutNonAuthoritative,
90 PutNoContent, PutNonAuthoritative,
91 ReflectMethod (reflectMethod),
91 ReflectMethod (reflectMethod),
92 Verb, StdMethod(..))
92 Verb, StdMethod(..))
93−import Servant.API.WithNamedConfig (WithNamedConfig)
93+import Servant.API.WithNamedContext (WithNamedContext)
94import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
94import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
95 URI (..), safeLink)
95 URI (..), safeLink)
96import Web.HttpApiData (FromHttpApiData (..),
96import Web.HttpApiData (FromHttpApiData (..),
servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+1−1
@@ -30,7 +30,7 @@ type ComprehensiveAPI =
30 Vault :> GET :<|>
30 Vault :> GET :<|>
31 Verb 'POST 204 '[JSON] () :<|>
31 Verb 'POST 204 '[JSON] () :<|>
32 Verb 'POST 204 '[JSON] Int :<|>
32 Verb 'POST 204 '[JSON] Int :<|>
33− WithNamedConfig "foo" '[] GET
33+ WithNamedContext "foo" '[] GET
34
34
35comprehensiveAPI :: Proxy ComprehensiveAPI
35comprehensiveAPI :: Proxy ComprehensiveAPI
36comprehensiveAPI = Proxy
36comprehensiveAPI = Proxy
servant/src/Servant/API/WithNamedConfig.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE KindSignatures #-}
3−
4−module Servant.API.WithNamedConfig where
5−
6−import GHC.TypeLits
7−
8−-- | 'WithNamedConfig' names a specific tagged configuration to use for the
9−-- combinators in the API. (See also in @servant-server@,
10−-- @Servant.Server.Config@.) For example:
11−--
12−-- > type UseNamedConfigAPI = WithNamedConfig "myConfig" '[String] (
13−-- > ReqBody '[JSON] Int :> Get '[JSON] Int)
14−--
15−-- Both the 'ReqBody' and 'Get' combinators will use the 'NamedConfig' with
16−-- type tag "myConfig" as their configuration.
17−--
18−-- 'Config's are only relevant for @servant-server@.
19−--
20−-- For more information, see the tutorial.
21−data WithNamedConfig (name :: Symbol) (subConfig :: [*]) subApi
servant/src/Servant/API/WithNamedContext.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE KindSignatures #-}
3+
4+module Servant.API.WithNamedContext where
5+
6+import GHC.TypeLits
7+
8+-- | 'WithNamedContext' names a specific tagged context to use for the
9+-- combinators in the API. (See also in @servant-server@,
10+-- @Servant.Server.Context@.) For example:
11+--
12+-- > type UseNamedContextAPI = WithNamedContext "myContext" '[String] (
13+-- > ReqBody '[JSON] Int :> Get '[JSON] Int)
14+--
15+-- Both the 'ReqBody' and 'Get' combinators will use the 'WithNamedContext' with
16+-- type tag "myContext" as their context.
17+--
18+-- 'Context's are only relevant for @servant-server@.
19+--
20+-- For more information, see the tutorial.
21+data WithNamedContext (name :: Symbol) (subContext :: [*]) subApi