From d81c8d99119d4cb896c59d81a98a37798b6aaa6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABl=20Deest?= Date: Fri, 8 Oct 2021 15:45:18 +0200 Subject: [PATCH] Add parameter-supplying operator Renamed `(/:)` to `(//)`, and used `(/:)` for supplying parameters to client functions. Should close #1442. --- .../src/Servant/Client/Core/HasClient.hs | 55 ++++++++++++++++--- .../src/Servant/Client/Core/Reexport.hs | 1 + .../test/Servant/ClientTestUtils.hs | 4 +- servant-client/test/Servant/GenericSpec.hs | 8 +-- 4 files changed, 55 insertions(+), 13 deletions(-) diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index a7573e5c..6f1f08eb 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -27,6 +27,7 @@ module Servant.Client.Core.HasClient ( HasClient (..), EmptyClient (..), AsClientT, + (//), (/:), foldMapUnion, matchUnion, @@ -54,7 +55,8 @@ import Data.Sequence (fromList) import qualified Data.Text as T import Network.HTTP.Media - (MediaType, matches, parseAccept, (//)) + (MediaType, matches, parseAccept) +import qualified Network.HTTP.Media as Media import qualified Data.Sequence as Seq import Data.SOP.BasicFunctors (I (I), (:.:) (Comp)) @@ -873,9 +875,12 @@ instance #endif -infixl 1 /: +infixl 1 // +infixl 2 /: --- | Convenience function for working with nested record-clients. +-- | Helper to make code using records of clients more readable. +-- +-- Can be mixed with (/:) for supplying arguments. -- -- Example: -- @@ -899,10 +904,46 @@ infixl 1 /: -- rootClient = client api -- -- endpointClient :: ClientM Person --- endpointClient = client /: subApi /: endpoint +-- endpointClient = client // subApi // endpoint -- @@ -(/:) :: a -> (a -> b) -> b -x /: f = f x +(//) :: a -> (a -> b) -> b +x // f = f x + +-- | Convenience function for supplying arguments to client functions when +-- working with records of clients. +-- +-- Intended to be use in conjunction with '(//)'. +-- +-- Example: +-- +-- @@ +-- type Api = NamedAPI RootApi +-- +-- data RootApi mode = RootApi +-- { subApi :: mode :- Capture "token" String :> NamedAPI SubApi +-- , hello :: mode :- Capture "name" String :> Get '[JSON] String +-- , … +-- } deriving Generic +-- +-- data SubAmi mode = SubApi +-- { endpoint :: mode :- Get '[JSON] Person +-- , … +-- } deriving Generic +-- +-- api :: Proxy API +-- api = Proxy +-- +-- rootClient :: RootApi (AsClientT ClientM) +-- rootClient = client api +-- +-- hello :: String -> ClientM String +-- hello name = rootClient // hello /: name +-- +-- endpointClient :: ClientM Person +-- endpointClient = client // subApi /: "foobar123" // endpoint +-- @@ +(/:) :: (a -> b -> c) -> b -> a -> c +(/:) = flip {- Note [Non-Empty Content Types] @@ -928,7 +969,7 @@ for empty and one for non-empty lists). checkContentTypeHeader :: RunClient m => Response -> m MediaType checkContentTypeHeader response = case lookup "Content-Type" $ toList $ responseHeaders response of - Nothing -> return $ "application"//"octet-stream" + Nothing -> return $ "application" Media.// "octet-stream" Just t -> case parseAccept t of Nothing -> throwClientError $ InvalidContentTypeHeader response Just t' -> return t' diff --git a/servant-client-core/src/Servant/Client/Core/Reexport.hs b/servant-client-core/src/Servant/Client/Core/Reexport.hs index 788e44b4..e7f43f71 100644 --- a/servant-client-core/src/Servant/Client/Core/Reexport.hs +++ b/servant-client-core/src/Servant/Client/Core/Reexport.hs @@ -8,6 +8,7 @@ module Servant.Client.Core.Reexport , foldMapUnion , matchUnion , AsClientT + , (//) , (/:) -- * Response (for @Raw@) diff --git a/servant-client/test/Servant/ClientTestUtils.hs b/servant-client/test/Servant/ClientTestUtils.hs index 944c9614..d7f6578f 100644 --- a/servant-client/test/Servant/ClientTestUtils.hs +++ b/servant-client/test/Servant/ClientTestUtils.hs @@ -111,7 +111,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] data RecordRoutes mode = RecordRoutes { version :: mode :- "version" :> Get '[JSON] Int , echo :: mode :- "echo" :> Capture "string" String :> Get '[JSON] String - , otherRoutes :: mode :- "other" :> NamedRoutes OtherRoutes + , otherRoutes :: mode :- "other" :> Capture "someParam" Int :> NamedRoutes OtherRoutes } deriving Generic data OtherRoutes mode = OtherRoutes @@ -246,7 +246,7 @@ server = serve api ( :<|> RecordRoutes { version = pure 42 , echo = pure - , otherRoutes = OtherRoutes + , otherRoutes = \_ -> OtherRoutes { something = pure ["foo", "bar", "pweet"] } } diff --git a/servant-client/test/Servant/GenericSpec.hs b/servant-client/test/Servant/GenericSpec.hs index b347cf57..61ab5eb4 100644 --- a/servant-client/test/Servant/GenericSpec.hs +++ b/servant-client/test/Servant/GenericSpec.hs @@ -19,7 +19,7 @@ module Servant.GenericSpec (spec) where import Test.Hspec -import Servant.Client ((/:)) +import Servant.Client ((//), (/:)) import Servant.ClientTestUtils spec :: Spec @@ -31,7 +31,7 @@ genericSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do context "Record clients work as expected" $ do it "Client functions return expected values" $ \(_,baseUrl) -> do - runClient (recordRoutes /: version) baseUrl `shouldReturn` Right 42 - runClient (recordRoutes /: echo $ "foo") baseUrl `shouldReturn` Right "foo" + runClient (recordRoutes // version) baseUrl `shouldReturn` Right 42 + runClient (recordRoutes // echo /: "foo") baseUrl `shouldReturn` Right "foo" it "Clients can be nested" $ \(_,baseUrl) -> do - runClient (recordRoutes /: otherRoutes /: something) baseUrl `shouldReturn` Right ["foo", "bar", "pweet"] + runClient (recordRoutes // otherRoutes /: 42 // something) baseUrl `shouldReturn` Right ["foo", "bar", "pweet"]