Add parameter-supplying operator
Renamed `(/:)` to `(//)`, and used `(/:)` for supplying parameters to client functions. Should close #1442.
This commit is contained in:
parent
6718752b4a
commit
d81c8d9911
4 changed files with 55 additions and 13 deletions
|
@ -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'
|
||||
|
|
|
@ -8,6 +8,7 @@ module Servant.Client.Core.Reexport
|
|||
, foldMapUnion
|
||||
, matchUnion
|
||||
, AsClientT
|
||||
, (//)
|
||||
, (/:)
|
||||
|
||||
-- * Response (for @Raw@)
|
||||
|
|
|
@ -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"]
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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"]
|
||||
|
|
Loading…
Reference in a new issue