config: added instances for all interpretations

This commit is contained in:
Sönke Hahn 2016-01-18 21:27:19 +01:00
parent 67315c4487
commit 2176fecfda
6 changed files with 27 additions and 2 deletions

View file

@ -417,6 +417,12 @@ instance HasClient api => HasClient (IsSecure :> api) where
clientWithRoute Proxy req baseurl manager = clientWithRoute Proxy req baseurl manager =
clientWithRoute (Proxy :: Proxy api) 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] {- Note [Non-Empty Content Types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

View file

@ -794,6 +794,9 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
docsFor Proxy ep = docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) 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 -- ToSample instances for simple types
instance ToSample () instance ToSample ()
instance ToSample Bool instance ToSample Bool

View file

@ -295,6 +295,13 @@ instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
foreignFor lang Proxy req = foreignFor lang Proxy req =
foreignFor lang (Proxy :: Proxy sublayout) 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 instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
type Foreign (HttpVersion :> sublayout) = Foreign sublayout type Foreign (HttpVersion :> sublayout) = Foreign sublayout

View file

@ -160,6 +160,9 @@ instance HasMock Raw where
where genBody = pack <$> generate (vector 100 :: Gen [Char]) 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 :: (MonadIO m, Arbitrary a) => m a
mockArbitrary = liftIO (generate arbitrary) mockArbitrary = liftIO (generate arbitrary)

View file

@ -60,11 +60,16 @@ import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.Router import Servant.Server.Internal.Router
(tweakResponse, runRouter, (tweakResponse, runRouter,
Router, Router'(LeafRouter)) Router, Router'(LeafRouter))
import Servant.Server.Internal.Config
(Config(..), NamedConfig(..))
-- * comprehensive api test -- * comprehensive api test
-- This declaration simply checks that all instances are in place. -- This declaration simply checks that all instances are in place.
_ = serve comprehensiveAPI _ = serve comprehensiveAPI comprehensiveApiConfig
comprehensiveApiConfig :: Config '[NamedConfig "foo" '[]]
comprehensiveApiConfig = NamedConfig EmptyConfig :. EmptyConfig
-- * Specs -- * Specs

View file

@ -29,7 +29,8 @@ type ComprehensiveAPI =
"foo" :> GET :<|> "foo" :> GET :<|>
Vault :> GET :<|> Vault :> GET :<|>
Verb 'POST 204 '[JSON] () :<|> Verb 'POST 204 '[JSON] () :<|>
Verb 'POST 204 '[JSON] Int Verb 'POST 204 '[JSON] Int :<|>
WithNamedConfig "foo" '[] GET
comprehensiveAPI :: Proxy ComprehensiveAPI comprehensiveAPI :: Proxy ComprehensiveAPI
comprehensiveAPI = Proxy comprehensiveAPI = Proxy