eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

config: remove HasConfig and make HasServer take config as a parameter

Browse source
This commit is contained in:
Sönke Hahn 2016-01-19 00:19:51 +01:00
parent 35bdc54dee
commit df09f8616e
9 changed files with 94 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
servant-client/test/Servant/ClientSpec.hs
View file

@ -288,9 +288,8 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where
WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a
, HasConfig api '[], HasClient api
, Client api ~ ExceptT ServantError IO ()) =>
WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
HasClient api, Client api ~ ExceptT ServantError IO ()) =>
Proxy api -> WrappedApi

9
servant-examples/auth-combinator/auth-combinator.hs
View file

@ -1,10 +1,13 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Aeson
import Data.ByteString (ByteString)
@ -32,10 +35,10 @@ isGoodCookie ref password = do
data AuthProtected
instance HasServer rest => HasServer (AuthProtected :> rest) where
instance (HasConfigEntry config DBConnection, HasServer rest config)
=> HasServer (AuthProtected :> rest) config where
type ServerT (AuthProtected :> rest) m = ServerT rest m
type HasConfig (AuthProtected :> rest) config =
(HasConfigEntry config DBConnection, HasConfig rest config)
route Proxy config subserver = WithRequest $ \ request ->
route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request

2
servant-mock/example/main.hs
View file

@ -20,4 +20,4 @@ api :: Proxy API
api = Proxy
main :: IO ()
main = run 8080 (serve api EmptyConfig $ mock api)
main = run 8080 (serve api EmptyConfig $ mock api Proxy)

76
servant-mock/src/Servant/Mock.hs
View file

@ -2,8 +2,9 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@ -66,6 +67,7 @@ import Network.HTTP.Types.Status
import Network.Wai
import Servant
import Servant.API.ContentTypes
import Servant.Server.Internal.Config
import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
import Test.QuickCheck.Gen (Gen, generate)
@ -73,7 +75,7 @@ import Test.QuickCheck.Gen (Gen, generate)
-- than turns them into random-response-generating
-- request handlers, hence providing an instance for
-- all the combinators of the core /servant/ library.
class HasServer api => HasMock api where
class HasServer api config => HasMock api config where
-- | Calling this method creates request handlers of
-- the right type to implement the API described by
-- @api@ that just generate random response values of
@ -103,65 +105,67 @@ class HasServer api => HasMock api where
-- So under the hood, 'mock' uses the 'IO' bit to generate
-- random values of type 'User' and 'Book' every time these
-- endpoints are requested.
mock :: Proxy api -> Server api
mock :: Proxy api -> Proxy config -> Server api
instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
mock _ = mock (Proxy :: Proxy a) :<|> mock (Proxy :: Proxy b)
instance (HasMock a config, HasMock b config) => HasMock (a :<|> b) config where
mock _ config = mock (Proxy :: Proxy a) config :<|> mock (Proxy :: Proxy b) config
instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
instance (KnownSymbol path, HasMock rest config) => HasMock (path :> rest) config where
mock _ = mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest) => HasMock (Capture s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest config) => HasMock (Capture s a :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (AllCTUnrender ctypes a, HasMock rest config) => HasMock (ReqBody ctypes a :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance HasMock rest => HasMock (RemoteHost :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest config => HasMock (RemoteHost :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance HasMock rest => HasMock (IsSecure :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest config => HasMock (IsSecure :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance HasMock rest => HasMock (Vault :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest config => HasMock (Vault :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance HasMock rest => HasMock (HttpVersion :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest config => HasMock (HttpVersion :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (QueryParam s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
=> HasMock (QueryParam s a :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (QueryParams s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
=> HasMock (QueryParams s a :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest config) => HasMock (QueryFlag s :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol h, FromHttpApiData a, HasMock rest config) => HasMock (Header h a :> rest) config where
mock _ config = \_ -> mock (Proxy :: Proxy rest) config
instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
=> HasMock (Verb method status ctypes a) where
mock _ = mockArbitrary
=> HasMock (Verb method status ctypes a) config where
mock _ _ = mockArbitrary
instance OVERLAPPING_
(GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
=> HasMock (Verb method status ctypes (Headers headerTypes a)) where
mock _ = mockArbitrary
=> HasMock (Verb method status ctypes (Headers headerTypes a)) config where
mock _ _ = mockArbitrary
instance HasMock Raw where
mock _ = \_req respond -> do
instance HasMock Raw config where
mock _ _ = \_req respond -> do
bdy <- genBody
respond $ responseLBS status200 [] bdy
where genBody = pack <$> generate (vector 100 :: Gen [Char])
instance HasMock rest => HasMock (WithNamedConfig name config rest) where
mock _ = mock (Proxy :: Proxy rest)
instance (HasConfigEntry config (NamedConfig name subConfig), HasMock rest subConfig) =>
HasMock (WithNamedConfig name subConfig rest) config where
mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subConfig)
mockArbitrary :: (MonadIO m, Arbitrary a) => m a
mockArbitrary = liftIO (generate arbitrary)

10
servant-mock/test/Servant/MockSpec.hs
View file

@ -1,5 +1,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
@ -21,7 +23,7 @@ import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Mock
-- This declaration simply checks that all instances are in place.
_ = mock comprehensiveAPI
_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedConfig "foo" '[]])
data Body
= Body
@ -50,7 +52,7 @@ spec = do
context "Get" $ do
let api :: Proxy (Get '[JSON] Body)
api = Proxy
app = serve api (mock api)
app = serve api EmptyConfig (mock api Proxy)
with (return app) $ do
it "serves arbitrary response bodies" $ do
get "/" `shouldRespondWith` 200{
@ -62,8 +64,8 @@ spec = do
withHeader = Proxy
withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
withoutHeader = Proxy
toApp :: HasMock api => Proxy api -> IO Application
toApp api = return $ serve api (mock api)
toApp :: (HasMock api '[]) => Proxy api -> IO Application
toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))
with (toApp withHeader) $ do
it "serves arbitrary response bodies" $ do
get "/" `shouldRespondWith` 200{

4
servant-server/src/Servant/Server.hs
View file

@ -110,8 +110,8 @@ import Servant.Server.Internal.Enter
-- > main :: IO ()
-- > main = Network.Wai.Handler.Warp.run 8080 app
--
serve :: (HasConfig layout a, HasServer layout)
=> Proxy layout -> Config a -> Server layout -> Application
serve :: (HasServer layout config)
=> Proxy layout -> Config config -> Server layout -> Application
serve p config server = toApplication (runRouter (route p config d))
where
d = Delayed r r r (\ _ _ -> Route server)

69
servant-server/src/Servant/Server/Internal.hs
View file

@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
@ -68,11 +69,10 @@ import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr
class HasServer layout where
class HasServer layout config where
type ServerT layout (m :: * -> *) :: *
type HasConfig layout (c :: [*]) :: Constraint
route :: HasConfig layout config => Proxy layout -> Config config -> Delayed (Server layout) -> Router
route :: Proxy layout -> Config config -> Delayed (Server layout) -> Router
type Server layout = ServerT layout (ExceptT ServantErr IO)
@ -89,10 +89,9 @@ type Server layout = ServerT layout (ExceptT ServantErr IO)
-- > server = listAllBooks :<|> postBook
-- > where listAllBooks = ...
-- > postBook book = ...
instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
instance (HasServer a config, HasServer b config) => HasServer (a :<|> b) config where
type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
type HasConfig (a :<|> b) c = (HasConfig a c, HasConfig b c)
route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server))
(route pb config ((\ (_ :<|> b) -> b) <$> server))
@ -119,12 +118,11 @@ captured _ = parseUrlPieceMaybe
-- > server = getBook
-- > where getBook :: Text -> ExceptT ServantErr IO Book
-- > getBook isbn = ...
instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
=> HasServer (Capture capture a :> sublayout) where
instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout config)
=> HasServer (Capture capture a :> sublayout) config where
type ServerT (Capture capture a :> sublayout) m =
a -> ServerT sublayout m
type HasConfig (Capture capture a :> sublayout) c = (HasConfig sublayout c)
route Proxy config d =
DynamicRouter $ \ first ->
@ -198,10 +196,9 @@ methodRouterHeaders method proxy status action = LeafRouter route'
instance OVERLAPPABLE_
( AllCTRender ctypes a, ReflectMethod method, KnownNat status
) => HasServer (Verb method status ctypes a) where
) => HasServer (Verb method status ctypes a) config where
type ServerT (Verb method status ctypes a) m = m a
type HasConfig (Verb method status ctypes a) c = ()
route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method)
@ -210,10 +207,9 @@ instance OVERLAPPABLE_
instance OVERLAPPING_
( AllCTRender ctypes a, ReflectMethod method, KnownNat status
, GetHeaders (Headers h a)
) => HasServer (Verb method status ctypes (Headers h a)) where
) => HasServer (Verb method status ctypes (Headers h a)) config where
type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
type HasConfig (Verb method status ctypes (Headers h a)) c = ()
route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method)
@ -239,12 +235,11 @@ instance OVERLAPPING_
-- > server = viewReferer
-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
-- > viewReferer referer = return referer
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (Header sym a :> sublayout) where
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
=> HasServer (Header sym a :> sublayout) config where
type ServerT (Header sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
type HasConfig (Header sym a :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = WithRequest $ \ request ->
let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
@ -272,12 +267,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (QueryParam sym a :> sublayout) where
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
=> HasServer (QueryParam sym a :> sublayout) config where
type ServerT (QueryParam sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
type HasConfig (QueryParam sym a :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
@ -309,12 +303,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (QueryParams sym a :> sublayout) where
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
=> HasServer (QueryParams sym a :> sublayout) config where
type ServerT (QueryParams sym a :> sublayout) m =
[a] -> ServerT sublayout m
type HasConfig (QueryParams sym a :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
@ -341,12 +334,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
-- > server = getBooks
-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
instance (KnownSymbol sym, HasServer sublayout)
=> HasServer (QueryFlag sym :> sublayout) where
instance (KnownSymbol sym, HasServer sublayout config)
=> HasServer (QueryFlag sym :> sublayout) config where
type ServerT (QueryFlag sym :> sublayout) m =
Bool -> ServerT sublayout m
type HasConfig (QueryFlag sym :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
@ -367,10 +359,9 @@ instance (KnownSymbol sym, HasServer sublayout)
-- >
-- > server :: Server MyApi
-- > server = serveDirectory "/var/www/images"
instance HasServer Raw where
instance HasServer Raw config where
type ServerT Raw m = Application
type HasConfig Raw c = ()
route Proxy _ rawApplication = LeafRouter $ \ request respond -> do
r <- runDelayed rawApplication
@ -400,12 +391,11 @@ instance HasServer Raw where
-- > server = postBook
-- > where postBook :: Book -> ExceptT ServantErr IO Book
-- > postBook book = ...insert into your db...
instance ( AllCTUnrender list a, HasServer sublayout
) => HasServer (ReqBody list a :> sublayout) where
instance ( AllCTUnrender list a, HasServer sublayout config
) => HasServer (ReqBody list a :> sublayout) config where
type ServerT (ReqBody list a :> sublayout) m =
a -> ServerT sublayout m
type HasConfig (ReqBody list a :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = WithRequest $ \ request ->
route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request))
@ -426,42 +416,37 @@ instance ( AllCTUnrender list a, HasServer sublayout
-- | Make sure the incoming request starts with @"/path"@, strip it and
-- pass the rest of the request path to @sublayout@.
instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
instance (KnownSymbol path, HasServer sublayout config) => HasServer (path :> sublayout) config where
type ServerT (path :> sublayout) m = ServerT sublayout m
type HasConfig (path :> sublayout) c = HasConfig sublayout c
route Proxy config subserver = StaticRouter $
M.singleton (cs (symbolVal proxyPath))
(route (Proxy :: Proxy sublayout) config subserver)
where proxyPath = Proxy :: Proxy path
instance HasServer api => HasServer (RemoteHost :> api) where
instance HasServer api config => HasServer (RemoteHost :> api) config where
type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
type HasConfig (RemoteHost :> api) c = HasConfig api c
route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req)
instance HasServer api => HasServer (IsSecure :> api) where
instance HasServer api config => HasServer (IsSecure :> api) config where
type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
type HasConfig (IsSecure :> api) c = HasConfig api c
route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) config (passToServer subserver $ secure req)
where secure req = if isSecure req then Secure else NotSecure
instance HasServer api => HasServer (Vault :> api) where
instance HasServer api config => HasServer (Vault :> api) config where
type ServerT (Vault :> api) m = Vault -> ServerT api m
type HasConfig (Vault :> api) c = HasConfig api c
route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) config (passToServer subserver $ vault req)
instance HasServer api => HasServer (HttpVersion :> api) where
instance HasServer api config => HasServer (HttpVersion :> api) config where
type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
type HasConfig (HttpVersion :> api) c = HasConfig api c
route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req)
@ -477,11 +462,11 @@ ct_wildcard = "*" <> "/" <> "*" -- Because CPP
-- * configs
instance HasServer subApi => HasServer (WithNamedConfig name subConfig subApi) where
instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig)
=> HasServer (WithNamedConfig name subConfig subApi) config where
type ServerT (WithNamedConfig name subConfig subApi) m =
ServerT subApi m
type HasConfig (WithNamedConfig name subConfig subApi) config =
(HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
route Proxy config delayed =
route subProxy subConfig delayed

19
servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
@ -24,13 +25,11 @@ import Servant.Server.Internal.RoutingApplication
data ExtractFromConfig
instance (HasServer subApi) =>
HasServer (ExtractFromConfig :> subApi) where
instance (HasConfigEntry config String, HasServer subApi config) =>
HasServer (ExtractFromConfig :> subApi) config where
type ServerT (ExtractFromConfig :> subApi) m =
String -> ServerT subApi m
type HasConfig (ExtractFromConfig :> subApi) (c :: [*]) =
(HasConfigEntry c String, HasConfig subApi c)
route Proxy config delayed =
route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@ -42,13 +41,11 @@ instance (HasServer subApi) =>
data InjectIntoConfig
instance (HasServer subApi) =>
HasServer (InjectIntoConfig :> subApi) where
instance (HasServer subApi (String ': config)) =>
HasServer (InjectIntoConfig :> subApi) config where
type ServerT (InjectIntoConfig :> subApi) m =
ServerT subApi m
type HasConfig (InjectIntoConfig :> subApi) c =
(HasConfig subApi (String ': c))
route Proxy config delayed =
route subProxy newConfig delayed
@ -60,13 +57,11 @@ instance (HasServer subApi) =>
data NamedConfigWithBirdface (name :: Symbol) (subConfig :: [*])
instance (HasServer subApi) =>
HasServer (NamedConfigWithBirdface name subConfig :> subApi) where
instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig) =>
HasServer (NamedConfigWithBirdface name subConfig :> subApi) config where
type ServerT (NamedConfigWithBirdface name subConfig :> subApi) m =
ServerT subApi m
type HasConfig (NamedConfigWithBirdface name subConfig :> subApi) config =
(HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
route Proxy config delayed =
route subProxy subConfig delayed

5
servant-server/test/Servant/ServerSpec.hs
View file

@ -1,14 +1,15 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Servant.ServerSpec where