diff --git a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs index 4d3c6926..eef48909 100644 --- a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs +++ b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs @@ -10,8 +10,8 @@ -- fixme: document dependency problem module Servant.Server.Utils.CustomCombinators ( - CombinatorImplementation, - runCI, + ServerCombinator, + runServerCombinator, makeCaptureCombinator, makeRequestCheckCombinator, makeAuthCombinator, @@ -34,31 +34,31 @@ import Servant.API import Servant.Server import Servant.Server.Internal -data CombinatorImplementation combinator arg api context where +data ServerCombinator combinator arg api context where CI :: (forall env . Proxy (combinator :> api) -> Context context -> Delayed env (WithArg arg (Server api)) -> Router' env RoutingApplication) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context -- fixme: get rid of WithArg? type family WithArg arg rest where WithArg () rest = rest WithArg arg rest = arg -> rest -runCI :: CombinatorImplementation combinator arg api context +runServerCombinator :: ServerCombinator combinator arg api context -> Proxy (combinator :> api) -> Context context -> Delayed env (WithArg arg (Server api)) -> Router' env RoutingApplication -runCI (CI i) = i +runServerCombinator (CI i) = i makeCaptureCombinator :: (HasServer api context, WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) => (Context context -> Text -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context makeCaptureCombinator = inner -- we use 'inner' to avoid having 'forall' show up in haddock docs where inner :: @@ -66,7 +66,7 @@ makeCaptureCombinator = inner -- we use 'inner' to avoid having 'forall' show up (HasServer api context, WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) => (Context context -> Text -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context inner getArg = CI $ \ Proxy context delayed -> CaptureRouter $ route (Proxy :: Proxy api) context $ addCapture delayed $ \ captured -> @@ -76,7 +76,7 @@ makeRequestCheckCombinator :: (HasServer api context, WithArg () (ServerT api Handler) ~ ServerT api Handler) => (Context context -> Request -> IO (RouteResult ())) - -> CombinatorImplementation combinator () api context + -> ServerCombinator combinator () api context makeRequestCheckCombinator = inner where inner :: @@ -84,7 +84,7 @@ makeRequestCheckCombinator = inner (HasServer api context, WithArg () (ServerT api Handler) ~ ServerT api Handler) => (Context context -> Request -> IO (RouteResult ())) - -> CombinatorImplementation combinator () api context + -> ServerCombinator combinator () api context inner check = CI $ \ Proxy context delayed -> route (Proxy :: Proxy api) context $ addMethodCheck delayed $ withRequest $ \ request -> @@ -94,7 +94,7 @@ makeAuthCombinator :: (HasServer api context, WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) => (Context context -> Request -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context makeAuthCombinator = inner where inner :: @@ -102,7 +102,7 @@ makeAuthCombinator = inner (HasServer api context, WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler)) => (Context context -> Request -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context inner authCheck = CI $ \ Proxy context delayed -> route (Proxy :: Proxy api) context $ addAuthCheck delayed $ withRequest $ \ request -> @@ -113,7 +113,7 @@ makeReqBodyCombinator :: WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler), HasServer api context) => (Context context -> IO ByteString -> arg) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context makeReqBodyCombinator = inner where inner :: @@ -122,7 +122,7 @@ makeReqBodyCombinator = inner WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler), HasServer api context) => (Context context -> IO ByteString -> arg) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context inner getArg = CI $ \ Proxy context delayed -> route (Proxy :: Proxy api) context $ addBodyCheck delayed (return ()) @@ -134,7 +134,7 @@ makeCombinator :: WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler), HasServer api context) => (Context context -> Request -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context makeCombinator = inner where inner :: @@ -143,7 +143,7 @@ makeCombinator = inner WithArg arg (ServerT api Handler) ~ (arg -> ServerT api Handler), HasServer api context) => (Context context -> Request -> IO (RouteResult arg)) - -> CombinatorImplementation combinator arg api context + -> ServerCombinator combinator arg api context inner getArg = CI $ \ Proxy context delayed -> route (Proxy :: Proxy api) context $ addBodyCheck delayed (return ()) diff --git a/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs b/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs index 08a91e0b..a65737e7 100644 --- a/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs +++ b/servant-server/test/Servant/Server/Utils/CustomCombinatorsSpec.hs @@ -186,7 +186,7 @@ data StringCapture instance HasServer api context => HasServer (StringCapture :> api) context where type ServerT (StringCapture :> api) m = String -> ServerT api m - route = runCI $ makeCaptureCombinator (const getCapture) + route = runServerCombinator $ makeCaptureCombinator (const getCapture) getCapture :: Text -> IO (RouteResult String) getCapture snippet = return $ case snippet of @@ -199,7 +199,7 @@ data CheckFooHeader instance HasServer api context => HasServer (CheckFooHeader :> api) context where type ServerT (CheckFooHeader :> api) m = ServerT api m - route = runCI $ makeRequestCheckCombinator (const checkFooHeader) + route = runServerCombinator $ makeRequestCheckCombinator (const checkFooHeader) checkFooHeader :: Request -> IO (RouteResult ()) checkFooHeader request = return $ @@ -212,7 +212,7 @@ data InvalidRequestCheckCombinator instance HasServer api context => HasServer (InvalidRequestCheckCombinator :> api) context where type ServerT (InvalidRequestCheckCombinator :> api) m = ServerT api m - route = runCI $ makeRequestCheckCombinator (const accessReqBody) + route = runServerCombinator $ makeRequestCheckCombinator (const accessReqBody) accessReqBody :: Request -> IO (RouteResult ()) accessReqBody request = do @@ -228,7 +228,7 @@ data User = User String instance HasServer api context => HasServer (AuthCombinator :> api) context where type ServerT (AuthCombinator :> api) m = User -> ServerT api m - route = runCI $ makeAuthCombinator (const checkAuth) + route = runServerCombinator $ makeAuthCombinator (const checkAuth) checkAuth :: Request -> IO (RouteResult User) checkAuth request = return $ case lookup "Auth" (requestHeaders request) of @@ -241,7 +241,7 @@ data InvalidAuthCombinator instance HasServer api context => HasServer (InvalidAuthCombinator :> api) context where type ServerT (InvalidAuthCombinator :> api) m = User -> ServerT api m - route = runCI $ makeAuthCombinator (const authWithReqBody) + route = runServerCombinator $ makeAuthCombinator (const authWithReqBody) authWithReqBody :: Request -> IO (RouteResult User) authWithReqBody request = do @@ -253,7 +253,7 @@ data AuthWithContext instance (HasContextEntry context [(SBS.ByteString, User)], HasServer api context) => HasServer (AuthWithContext :> api) context where type ServerT (AuthWithContext :> api) m = User -> ServerT api m - route = runCI $ makeAuthCombinator authWithContext + route = runServerCombinator $ makeAuthCombinator authWithContext authWithContext :: (HasContextEntry context [(SBS.ByteString, User)]) => Context context -> Request -> IO (RouteResult User) @@ -269,7 +269,7 @@ data FooHeader instance HasServer api context => HasServer (FooHeader :> api) context where type ServerT (FooHeader :> api) m = String -> ServerT api m - route = runCI $ makeCombinator (const getCustom) + route = runServerCombinator $ makeCombinator (const getCustom) getCustom :: Request -> IO (RouteResult String) getCustom request = return $ case lookup "Foo" (requestHeaders request) of @@ -284,7 +284,7 @@ data Source = Source (IO SBS.ByteString) instance HasServer api context => HasServer (StreamRequest :> api) context where type ServerT (StreamRequest :> api) m = Source -> ServerT api m - route = runCI $ makeReqBodyCombinator (const getSource) + route = runServerCombinator $ makeReqBodyCombinator (const getSource) getSource :: IO SBS.ByteString -> Source getSource = Source