diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index bab4f4a2..82779651 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -417,6 +417,12 @@ instance HasClient api => HasClient (IsSecure :> api) where clientWithRoute Proxy req baseurl manager = clientWithRoute (Proxy :: Proxy api) req baseurl manager +instance HasClient subapi => + HasClient (WithNamedConfig name config subapi) where + + type Client (WithNamedConfig name config subapi) = Client subapi + clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi) + {- Note [Non-Empty Content Types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 2b4db3eb..70f8954c 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -794,6 +794,9 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where docsFor Proxy ep = docsFor (Proxy :: Proxy sublayout) ep +instance HasDocs sublayout => HasDocs (WithNamedConfig name config sublayout) where + docsFor Proxy = docsFor (Proxy :: Proxy sublayout) + -- ToSample instances for simple types instance ToSample () instance ToSample Bool diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index ae199202..bb2e4b1e 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -295,6 +295,13 @@ instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) req +instance HasForeign lang sublayout => + HasForeign lang (WithNamedConfig name config sublayout) where + + type Foreign (WithNamedConfig name config sublayout) = Foreign sublayout + + foreignFor lang Proxy = foreignFor lang (Proxy :: Proxy sublayout) + instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where type Foreign (HttpVersion :> sublayout) = Foreign sublayout diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index d2808be2..ae6afd55 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -160,6 +160,9 @@ instance HasMock Raw where where genBody = pack <$> generate (vector 100 :: Gen [Char]) +instance HasMock rest => HasMock (WithNamedConfig name config rest) where + mock _ = mock (Proxy :: Proxy rest) + mockArbitrary :: (MonadIO m, Arbitrary a) => m a mockArbitrary = liftIO (generate arbitrary) diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 0955e332..21fabd38 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -60,11 +60,16 @@ import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.Router (tweakResponse, runRouter, Router, Router'(LeafRouter)) +import Servant.Server.Internal.Config + (Config(..), NamedConfig(..)) -- * comprehensive api test -- This declaration simply checks that all instances are in place. -_ = serve comprehensiveAPI +_ = serve comprehensiveAPI comprehensiveApiConfig + +comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]] +comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig -- * Specs diff --git a/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs index 1914df8e..733968b2 100644 --- a/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs @@ -29,7 +29,8 @@ type ComprehensiveAPI = "foo" :> GET :<|> Vault :> GET :<|> Verb 'POST 204 '[JSON] () :<|> - Verb 'POST 204 '[JSON] Int + Verb 'POST 204 '[JSON] Int :<|> + WithNamedConfig "foo" '[] GET comprehensiveAPI :: Proxy ComprehensiveAPI comprehensiveAPI = Proxy