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 (..), HasClient (..),
EmptyClient (..), EmptyClient (..),
AsClientT, AsClientT,
(//),
(/:), (/:),
foldMapUnion, foldMapUnion,
matchUnion, matchUnion,
@ -54,7 +55,8 @@ import Data.Sequence
(fromList) (fromList)
import qualified Data.Text as T import qualified Data.Text as T
import Network.HTTP.Media import Network.HTTP.Media
(MediaType, matches, parseAccept, (//)) (MediaType, matches, parseAccept)
import qualified Network.HTTP.Media as Media
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.SOP.BasicFunctors import Data.SOP.BasicFunctors
(I (I), (:.:) (Comp)) (I (I), (:.:) (Comp))
@ -873,9 +875,12 @@ instance
#endif #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: -- Example:
-- --
@ -899,10 +904,46 @@ infixl 1 /:
-- rootClient = client api -- rootClient = client api
-- --
-- endpointClient :: ClientM Person -- endpointClient :: ClientM Person
-- endpointClient = client /: subApi /: endpoint -- endpointClient = client // subApi // endpoint
-- @@ -- @@
(/:) :: a -> (a -> b) -> b (//) :: a -> (a -> b) -> b
x /: f = f x 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] {- Note [Non-Empty Content Types]
@ -928,7 +969,7 @@ for empty and one for non-empty lists).
checkContentTypeHeader :: RunClient m => Response -> m MediaType checkContentTypeHeader :: RunClient m => Response -> m MediaType
checkContentTypeHeader response = checkContentTypeHeader response =
case lookup "Content-Type" $ toList $ responseHeaders response of 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 Just t -> case parseAccept t of
Nothing -> throwClientError $ InvalidContentTypeHeader response Nothing -> throwClientError $ InvalidContentTypeHeader response
Just t' -> return t' Just t' -> return t'

View file

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

View file

@ -111,7 +111,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
data RecordRoutes mode = RecordRoutes data RecordRoutes mode = RecordRoutes
{ version :: mode :- "version" :> Get '[JSON] Int { version :: mode :- "version" :> Get '[JSON] Int
, echo :: mode :- "echo" :> Capture "string" String :> Get '[JSON] String , echo :: mode :- "echo" :> Capture "string" String :> Get '[JSON] String
, otherRoutes :: mode :- "other" :> NamedRoutes OtherRoutes , otherRoutes :: mode :- "other" :> Capture "someParam" Int :> NamedRoutes OtherRoutes
} deriving Generic } deriving Generic
data OtherRoutes mode = OtherRoutes data OtherRoutes mode = OtherRoutes
@ -246,7 +246,7 @@ server = serve api (
:<|> RecordRoutes :<|> RecordRoutes
{ version = pure 42 { version = pure 42
, echo = pure , echo = pure
, otherRoutes = OtherRoutes , otherRoutes = \_ -> OtherRoutes
{ something = pure ["foo", "bar", "pweet"] { something = pure ["foo", "bar", "pweet"]
} }
} }

View file

@ -19,7 +19,7 @@ module Servant.GenericSpec (spec) where
import Test.Hspec import Test.Hspec
import Servant.Client ((/:)) import Servant.Client ((//), (/:))
import Servant.ClientTestUtils import Servant.ClientTestUtils
spec :: Spec spec :: Spec
@ -31,7 +31,7 @@ genericSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
context "Record clients work as expected" $ do context "Record clients work as expected" $ do
it "Client functions return expected values" $ \(_,baseUrl) -> do it "Client functions return expected values" $ \(_,baseUrl) -> do
runClient (recordRoutes /: version) baseUrl `shouldReturn` Right 42 runClient (recordRoutes // version) baseUrl `shouldReturn` Right 42
runClient (recordRoutes /: echo $ "foo") baseUrl `shouldReturn` Right "foo" runClient (recordRoutes // echo /: "foo") baseUrl `shouldReturn` Right "foo"
it "Clients can be nested" $ \(_,baseUrl) -> do 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"]