git.iko.soy/typeable/servant
on master help sign in
servant-client support for CaptureAll
7fb9a95Jonathan Lange
servant-client/src/Servant/Client.hs+32
compare with master
unifiedsplit
@@ -118,6 +118,38 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
118
118
119 where p = unpack (toUrlPiece val)
119 where p = unpack (toUrlPiece val)
120
120
121+-- | If you use a 'CaptureAll' in one of your endpoints in your API,
122+-- the corresponding querying function will automatically take an
123+-- additional argument of a list of the type specified by your
124+-- 'CaptureAll'. That function will take care of inserting a textual
125+-- representation of this value at the right place in the request
126+-- path.
127+--
128+-- You can control how these values are turned into text by specifying
129+-- a 'ToHttpApiData' instance of your type.
130+--
131+-- Example:
132+--
133+-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
134+-- >
135+-- > myApi :: Proxy
136+-- > myApi = Proxy
137+--
138+-- > getSourceFile :: [Text] -> Manager -> BaseUrl -> ClientM SourceFile
139+-- > getSourceFile = client myApi
140+-- > -- then you can use "getSourceFile" to query that endpoint
141+instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
142+ => HasClient (CaptureAll capture a :> sublayout) where
143+
144+ type Client (CaptureAll capture a :> sublayout) =
145+ [a] -> Client sublayout
146+
147+ clientWithRoute Proxy req vals =
148+ clientWithRoute (Proxy :: Proxy sublayout)
149+ (foldl' (flip appendToPath) req ps)
150+
151+ where ps = map (unpack . toUrlPiece) vals
152+
121instance OVERLAPPABLE_
153instance OVERLAPPABLE_
122 -- Note [Non-Empty Content Types]
154 -- Note [Non-Empty Content Types]
123 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
155 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
servant-client/test/Servant/ClientSpec.hs+8−1
@@ -105,6 +105,7 @@ type Api =
105 "get" :> Get '[JSON] Person
105 "get" :> Get '[JSON] Person
106 :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
106 :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
107 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
107 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
108+ :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] Person
108 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
109 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
109 :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
110 :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
110 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
111 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
@@ -125,6 +126,7 @@ api = Proxy
125getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
126getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
126getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
127getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
127getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
128getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
129+getCaptureAll :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM Person
128getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
130getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
129getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
131getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
130getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
132getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
@@ -140,6 +142,7 @@ getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
140getGet
142getGet
141 :<|> getDeleteEmpty
143 :<|> getDeleteEmpty
142 :<|> getCapture
144 :<|> getCapture
145+ :<|> getCaptureAll
143 :<|> getBody
146 :<|> getBody
144 :<|> getQueryParam
147 :<|> getQueryParam
145 :<|> getQueryParams
148 :<|> getQueryParams
@@ -155,6 +158,7 @@ server = serve api (
155 return alice
158 return alice
156 :<|> return NoContent
159 :<|> return NoContent
157 :<|> (\ name -> return $ Person name 0)
160 :<|> (\ name -> return $ Person name 0)
161+ :<|> (\ (name : _) -> return $ Person name 0)
158 :<|> return
162 :<|> return
159 :<|> (\ name -> case name of
163 :<|> (\ name -> case name of
160 Just "alice" -> return alice
164 Just "alice" -> return alice
@@ -250,6 +254,9 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
250 it "Servant.API.Capture" $ \(_, baseUrl) -> do
254 it "Servant.API.Capture" $ \(_, baseUrl) -> do
251 (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
255 (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
252
256
257+ it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
258+ (left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
259+
253 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
260 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
254 let p = Person "Clara" 42
261 let p = Person "Clara" 42
255 (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
262 (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
@@ -351,7 +358,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
351 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
358 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
352
359
353 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
360 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
354− let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
361+ let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
355 Left res <- runExceptT (getBody alice manager baseUrl)
362 Left res <- runExceptT (getBody alice manager baseUrl)
356 case res of
363 case res of
357 InvalidContentTypeHeader "fooooo" _ -> return ()
364 InvalidContentTypeHeader "fooooo" _ -> return ()