From 6ca120f08fc54e91225358a43081a0de2805ff0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Wed, 13 Jan 2016 21:28:16 +0100 Subject: [PATCH] server: use {c,C}onfig instead of {c,C}fg everywhere --- servant-client/test/Servant/ClientSpec.hs | 2 +- .../auth-combinator/auth-combinator.hs | 4 +- servant-server/src/Servant/Server.hs | 10 +-- servant-server/src/Servant/Server/Internal.hs | 86 +++++++++---------- .../src/Servant/Server/Internal/Config.hs | 4 +- .../Server/UsingConfigSpec/TestCombinators.hs | 12 +-- 6 files changed, 59 insertions(+), 59 deletions(-) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 0243cc36..46bf3712 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -285,7 +285,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do data WrappedApi where WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a - , HasCfg api '[], HasClient api + , HasConfig api '[], HasClient api , Client api ~ ExceptT ServantError IO ()) => Proxy api -> WrappedApi diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs index 4c5c6c3c..87f1fcc7 100644 --- a/servant-examples/auth-combinator/auth-combinator.hs +++ b/servant-examples/auth-combinator/auth-combinator.hs @@ -34,8 +34,8 @@ data AuthProtected instance HasServer rest => HasServer (AuthProtected :> rest) where type ServerT (AuthProtected :> rest) m = ServerT rest m - type HasCfg (AuthProtected :> rest) config = - (HasConfigEntry config DBConnection, HasCfg rest config) + 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 diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 20f8b132..aae5de83 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -101,18 +101,18 @@ import Servant.Server.Internal.Enter -- > myApi :: Proxy MyApi -- > myApi = Proxy -- > --- > cfg :: Config '[] --- > cfg = EmptyConfig +-- > config :: Config '[] +-- > config = EmptyConfig -- > -- > app :: Application --- > app = serve myApi cfg server +-- > app = serve myApi config server -- > -- > main :: IO () -- > main = Network.Wai.Handler.Warp.run 8080 app -- -serve :: (HasCfg layout a, HasServer layout) +serve :: (HasConfig layout a, HasServer layout) => Proxy layout -> Config a -> Server layout -> Application -serve p cfg server = toApplication (runRouter (route p cfg d)) +serve p config server = toApplication (runRouter (route p config d)) where d = Delayed r r r (\ _ _ -> Route server) r = return (Route ()) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 15721a19..864ca819 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -69,9 +69,9 @@ import Servant.Server.Internal.ServantErr class HasServer layout where type ServerT layout (m :: * -> *) :: * - type HasCfg layout (c :: [*]) :: Constraint + type HasConfig layout (c :: [*]) :: Constraint - route :: HasCfg layout a => Proxy layout -> Config a -> Delayed (Server layout) -> Router + route :: HasConfig layout a => Proxy layout -> Config a -> Delayed (Server layout) -> Router type Server layout = ServerT layout (ExceptT ServantErr IO) @@ -91,10 +91,10 @@ type Server layout = ServerT layout (ExceptT ServantErr IO) instance (HasServer a, HasServer b) => HasServer (a :<|> b) where type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m - type HasCfg (a :<|> b) c = (HasCfg a c, HasCfg b c) + type HasConfig (a :<|> b) c = (HasConfig a c, HasConfig b c) - route Proxy cfg server = choice (route pa cfg ((\ (a :<|> _) -> a) <$> server)) - (route pb cfg ((\ (_ :<|> b) -> b) <$> server)) + route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server)) + (route pb config ((\ (_ :<|> b) -> b) <$> server)) where pa = Proxy :: Proxy a pb = Proxy :: Proxy b @@ -123,12 +123,12 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout) type ServerT (Capture capture a :> sublayout) m = a -> ServerT sublayout m - type HasCfg (Capture capture a :> sublayout) c = (HasCfg sublayout c) + type HasConfig (Capture capture a :> sublayout) c = (HasConfig sublayout c) - route Proxy cfg d = + route Proxy config d = DynamicRouter $ \ first -> route (Proxy :: Proxy sublayout) - cfg + config (addCapture d $ case captured captureProxy first of Nothing -> return $ Fail err404 Just v -> return $ Route v @@ -200,7 +200,7 @@ instance OVERLAPPABLE_ ) => HasServer (Verb method status ctypes a) where type ServerT (Verb method status ctypes a) m = m a - type HasCfg (Verb method status ctypes a) c = () + type HasConfig (Verb method status ctypes a) c = () route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) @@ -212,7 +212,7 @@ instance OVERLAPPING_ ) => HasServer (Verb method status ctypes (Headers h a)) where type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a) - type HasCfg (Verb method status ctypes (Headers h a)) c = () + type HasConfig (Verb method status ctypes (Headers h a)) c = () route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status where method = reflectMethod (Proxy :: Proxy method) @@ -243,11 +243,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) type ServerT (Header sym a :> sublayout) m = Maybe a -> ServerT sublayout m - type HasCfg (Header sym a :> sublayout) c = HasCfg sublayout c + type HasConfig (Header sym a :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = WithRequest $ \ request -> + route Proxy config subserver = WithRequest $ \ request -> let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request) - in route (Proxy :: Proxy sublayout) cfg (passToServer subserver mheader) + in route (Proxy :: Proxy sublayout) config (passToServer subserver mheader) where str = fromString $ symbolVal (Proxy :: Proxy sym) -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API, @@ -276,9 +276,9 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) type ServerT (QueryParam sym a :> sublayout) m = Maybe a -> ServerT sublayout m - type HasCfg (QueryParam sym a :> sublayout) c = HasCfg sublayout c + type HasConfig (QueryParam sym a :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = WithRequest $ \ request -> + route Proxy config subserver = WithRequest $ \ request -> let querytext = parseQueryText $ rawQueryString request param = case lookup paramname querytext of @@ -286,7 +286,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) Just Nothing -> Nothing -- param present with no value -> Nothing Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to -- the right type - in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param) + in route (Proxy :: Proxy sublayout) config (passToServer subserver param) where paramname = cs $ symbolVal (Proxy :: Proxy sym) -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API, @@ -313,16 +313,16 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout) type ServerT (QueryParams sym a :> sublayout) m = [a] -> ServerT sublayout m - type HasCfg (QueryParams sym a :> sublayout) c = HasCfg sublayout c + type HasConfig (QueryParams sym a :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = WithRequest $ \ request -> + route Proxy config subserver = WithRequest $ \ request -> let querytext = parseQueryText $ rawQueryString request -- if sym is "foo", we look for query string parameters -- named "foo" or "foo[]" and call parseQueryParam on the -- corresponding values parameters = filter looksLikeParam querytext values = mapMaybe (convert . snd) parameters - in route (Proxy :: Proxy sublayout) cfg (passToServer subserver values) + in route (Proxy :: Proxy sublayout) config (passToServer subserver values) where paramname = cs $ symbolVal (Proxy :: Proxy sym) looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") convert Nothing = Nothing @@ -345,15 +345,15 @@ instance (KnownSymbol sym, HasServer sublayout) type ServerT (QueryFlag sym :> sublayout) m = Bool -> ServerT sublayout m - type HasCfg (QueryFlag sym :> sublayout) c = HasCfg sublayout c + type HasConfig (QueryFlag sym :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = WithRequest $ \ request -> + route Proxy config subserver = WithRequest $ \ request -> let querytext = parseQueryText $ rawQueryString request param = case lookup paramname querytext of Just Nothing -> True -- param is there, with no value Just (Just v) -> examine v -- param with a value Nothing -> False -- param not in the query string - in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param) + in route (Proxy :: Proxy sublayout) config (passToServer subserver param) where paramname = cs $ symbolVal (Proxy :: Proxy sym) examine v | v == "true" || v == "1" || v == "" = True | otherwise = False @@ -369,7 +369,7 @@ instance (KnownSymbol sym, HasServer sublayout) instance HasServer Raw where type ServerT Raw m = Application - type HasCfg Raw c = () + type HasConfig Raw c = () route Proxy _ rawApplication = LeafRouter $ \ request respond -> do r <- runDelayed rawApplication @@ -404,10 +404,10 @@ instance ( AllCTUnrender list a, HasServer sublayout type ServerT (ReqBody list a :> sublayout) m = a -> ServerT sublayout m - type HasCfg (ReqBody list a :> sublayout) c = HasCfg sublayout c + type HasConfig (ReqBody list a :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = WithRequest $ \ request -> - route (Proxy :: Proxy sublayout) cfg (addBodyCheck subserver (bodyCheck request)) + route Proxy config subserver = WithRequest $ \ request -> + route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request)) where bodyCheck request = do -- See HTTP RFC 2616, section 7.2.1 @@ -428,42 +428,42 @@ instance ( AllCTUnrender list a, HasServer sublayout instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where type ServerT (path :> sublayout) m = ServerT sublayout m - type HasCfg (path :> sublayout) c = HasCfg sublayout c + type HasConfig (path :> sublayout) c = HasConfig sublayout c - route Proxy cfg subserver = StaticRouter $ + route Proxy config subserver = StaticRouter $ M.singleton (cs (symbolVal proxyPath)) - (route (Proxy :: Proxy sublayout) cfg subserver) + (route (Proxy :: Proxy sublayout) config subserver) where proxyPath = Proxy :: Proxy path instance HasServer api => HasServer (RemoteHost :> api) where type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m - type HasCfg (RemoteHost :> api) c = HasCfg api c + type HasConfig (RemoteHost :> api) c = HasConfig api c - route Proxy cfg subserver = WithRequest $ \req -> - route (Proxy :: Proxy api) cfg (passToServer subserver $ remoteHost req) + route Proxy config subserver = WithRequest $ \req -> + route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req) instance HasServer api => HasServer (IsSecure :> api) where type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m - type HasCfg (IsSecure :> api) c = HasCfg api c + type HasConfig (IsSecure :> api) c = HasConfig api c - route Proxy cfg subserver = WithRequest $ \req -> - route (Proxy :: Proxy api) cfg (passToServer subserver $ secure req) + 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 type ServerT (Vault :> api) m = Vault -> ServerT api m - type HasCfg (Vault :> api) c = HasCfg api c + type HasConfig (Vault :> api) c = HasConfig api c - route Proxy cfg subserver = WithRequest $ \req -> - route (Proxy :: Proxy api) cfg (passToServer subserver $ vault req) + route Proxy config subserver = WithRequest $ \req -> + route (Proxy :: Proxy api) config (passToServer subserver $ vault req) instance HasServer api => HasServer (HttpVersion :> api) where type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m - type HasCfg (HttpVersion :> api) c = HasCfg api c + type HasConfig (HttpVersion :> api) c = HasConfig api c - route Proxy cfg subserver = WithRequest $ \req -> - route (Proxy :: Proxy api) cfg (passToServer subserver $ httpVersion req) + route Proxy config subserver = WithRequest $ \req -> + route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req) pathIsEmpty :: Request -> Bool pathIsEmpty = go . pathInfo @@ -481,8 +481,8 @@ instance (HasServer subApi) => type ServerT (SubConfig name subConfig :> subApi) m = ServerT subApi m - type HasCfg (SubConfig name subConfig :> subApi) config = - (HasConfigEntry config (SubConfig name subConfig), HasCfg subApi subConfig) + type HasConfig (SubConfig name subConfig :> subApi) config = + (HasConfigEntry config (SubConfig name subConfig), HasConfig subApi subConfig) route Proxy config delayed = route subProxy subConfig delayed diff --git a/servant-server/src/Servant/Server/Internal/Config.hs b/servant-server/src/Servant/Server/Internal/Config.hs index 1147c2c8..5eab9431 100644 --- a/servant-server/src/Servant/Server/Internal/Config.hs +++ b/servant-server/src/Servant/Server/Internal/Config.hs @@ -33,8 +33,8 @@ instance Eq (Config '[]) where instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2 -class HasConfigEntry (cfg :: [*]) (val :: *) where - getConfigEntry :: Config cfg -> val +class HasConfigEntry (config :: [*]) (val :: *) where + getConfigEntry :: Config config -> val instance OVERLAPPABLE_ HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where diff --git a/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs b/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs index f17fcb1f..e7bb38dc 100644 --- a/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs +++ b/servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs @@ -26,8 +26,8 @@ instance (HasServer subApi) => type ServerT (ExtractFromConfig :> subApi) m = String -> ServerT subApi m - type HasCfg (ExtractFromConfig :> subApi) (c :: [*]) = - (HasConfigEntry c String, HasCfg subApi c) + 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)) @@ -44,8 +44,8 @@ instance (HasServer subApi) => type ServerT (InjectIntoConfig :> subApi) m = ServerT subApi m - type HasCfg (InjectIntoConfig :> subApi) c = - (HasCfg subApi (String ': c)) + type HasConfig (InjectIntoConfig :> subApi) c = + (HasConfig subApi (String ': c)) route Proxy config delayed = route subProxy newConfig delayed @@ -60,8 +60,8 @@ data Descend (name :: Symbol) (subConfig :: [*]) subApi instance HasServer subApi => HasServer (Descend name subConfig subApi) where type ServerT (Descend name subConfig subApi) m = ServerT subApi m - type HasCfg (Descend name subConfig subApi) config = - (HasConfigEntry config (SubConfig name subConfig), HasCfg subApi subConfig) + type HasConfig (Descend name subConfig subApi) config = + (HasConfigEntry config (SubConfig name subConfig), HasConfig subApi subConfig) route Proxy config delayed = route subProxy subConfig delayed