Add parameter-supplying operator

Renamed `(/:)` to `(//)`, and used `(/:)` for supplying parameters to
client functions.

Should close #1442.
This commit is contained in:
Gaël Deest 2021-10-08 15:45:18 +02:00
parent 6718752b4a
commit d81c8d9911
4 changed files with 55 additions and 13 deletions

View file

@ -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'

View file

@ -8,6 +8,7 @@ module Servant.Client.Core.Reexport
, foldMapUnion
, matchUnion
, AsClientT
, (//)
, (/:)
-- * Response (for @Raw@)

View file

@ -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"]
}
}

View file

@ -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"]