Add (/:) operator

This commit is contained in:
Gaël Deest 2021-10-04 16:11:27 +02:00
parent 5f8aaec146
commit 6718752b4a
3 changed files with 37 additions and 4 deletions

View file

@ -27,6 +27,7 @@ module Servant.Client.Core.HasClient (
HasClient (..), HasClient (..),
EmptyClient (..), EmptyClient (..),
AsClientT, AsClientT,
(/:),
foldMapUnion, foldMapUnion,
matchUnion, matchUnion,
) where ) where
@ -872,6 +873,37 @@ instance
#endif #endif
infixl 1 /:
-- | Convenience function for working with nested record-clients.
--
-- Example:
--
-- @@
-- type Api = NamedAPI RootApi
--
-- data RootApi mode = RootApi
-- { subApi :: mode :- NamedAPI SubApi
-- , …
-- } 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
--
-- endpointClient :: ClientM Person
-- endpointClient = client /: subApi /: endpoint
-- @@
(/:) :: a -> (a -> b) -> b
x /: f = f x
{- Note [Non-Empty Content Types] {- Note [Non-Empty Content Types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

View file

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

View file

@ -17,9 +17,9 @@
module Servant.GenericSpec (spec) where module Servant.GenericSpec (spec) where
import Data.Function ((&))
import Test.Hspec import Test.Hspec
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 /: something) baseUrl `shouldReturn` Right ["foo", "bar", "pweet"]