servant-client support for CaptureAll
This commit is contained in:
parent
0d8a5b5aff
commit
7fb9a95711
2 changed files with 40 additions and 1 deletions
|
@ -118,6 +118,38 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
|
||||||
|
|
||||||
where p = unpack (toUrlPiece val)
|
where p = unpack (toUrlPiece val)
|
||||||
|
|
||||||
|
-- | If you use a 'CaptureAll' in one of your endpoints in your API,
|
||||||
|
-- the corresponding querying function will automatically take an
|
||||||
|
-- additional argument of a list of the type specified by your
|
||||||
|
-- 'CaptureAll'. That function will take care of inserting a textual
|
||||||
|
-- representation of this value at the right place in the request
|
||||||
|
-- path.
|
||||||
|
--
|
||||||
|
-- You can control how these values are turned into text by specifying
|
||||||
|
-- a 'ToHttpApiData' instance of your type.
|
||||||
|
--
|
||||||
|
-- Example:
|
||||||
|
--
|
||||||
|
-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile
|
||||||
|
-- >
|
||||||
|
-- > myApi :: Proxy
|
||||||
|
-- > myApi = Proxy
|
||||||
|
--
|
||||||
|
-- > getSourceFile :: [Text] -> Manager -> BaseUrl -> ClientM SourceFile
|
||||||
|
-- > getSourceFile = client myApi
|
||||||
|
-- > -- then you can use "getSourceFile" to query that endpoint
|
||||||
|
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
|
||||||
|
=> HasClient (CaptureAll capture a :> sublayout) where
|
||||||
|
|
||||||
|
type Client (CaptureAll capture a :> sublayout) =
|
||||||
|
[a] -> Client sublayout
|
||||||
|
|
||||||
|
clientWithRoute Proxy req vals =
|
||||||
|
clientWithRoute (Proxy :: Proxy sublayout)
|
||||||
|
(foldl' (flip appendToPath) req ps)
|
||||||
|
|
||||||
|
where ps = map (unpack . toUrlPiece) vals
|
||||||
|
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
-- Note [Non-Empty Content Types]
|
-- Note [Non-Empty Content Types]
|
||||||
(MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
|
(MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
|
||||||
|
|
|
@ -105,6 +105,7 @@ type Api =
|
||||||
"get" :> Get '[JSON] Person
|
"get" :> Get '[JSON] Person
|
||||||
:<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
|
:<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
|
||||||
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
||||||
|
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] Person
|
||||||
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
|
||||||
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
|
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
|
||||||
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
|
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
|
||||||
|
@ -125,6 +126,7 @@ api = Proxy
|
||||||
getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
|
getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
|
||||||
getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
|
getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
|
||||||
getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
||||||
|
getCaptureAll :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
||||||
getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
||||||
getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
|
||||||
getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
|
getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
|
||||||
|
@ -140,6 +142,7 @@ getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
|
||||||
getGet
|
getGet
|
||||||
:<|> getDeleteEmpty
|
:<|> getDeleteEmpty
|
||||||
:<|> getCapture
|
:<|> getCapture
|
||||||
|
:<|> getCaptureAll
|
||||||
:<|> getBody
|
:<|> getBody
|
||||||
:<|> getQueryParam
|
:<|> getQueryParam
|
||||||
:<|> getQueryParams
|
:<|> getQueryParams
|
||||||
|
@ -155,6 +158,7 @@ server = serve api (
|
||||||
return alice
|
return alice
|
||||||
:<|> return NoContent
|
:<|> return NoContent
|
||||||
:<|> (\ name -> return $ Person name 0)
|
:<|> (\ name -> return $ Person name 0)
|
||||||
|
:<|> (\ (name : _) -> return $ Person name 0)
|
||||||
:<|> return
|
:<|> return
|
||||||
:<|> (\ name -> case name of
|
:<|> (\ name -> case name of
|
||||||
Just "alice" -> return alice
|
Just "alice" -> return alice
|
||||||
|
@ -250,6 +254,9 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
it "Servant.API.Capture" $ \(_, baseUrl) -> do
|
it "Servant.API.Capture" $ \(_, baseUrl) -> do
|
||||||
(left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
|
(left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
|
||||||
|
|
||||||
|
it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
|
||||||
|
(left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
|
||||||
|
|
||||||
it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
|
it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
|
||||||
let p = Person "Clara" 42
|
let p = Person "Clara" 42
|
||||||
(left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
|
(left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
|
||||||
|
@ -351,7 +358,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
||||||
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
|
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
|
||||||
|
|
||||||
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
|
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
|
||||||
let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
|
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
|
||||||
Left res <- runExceptT (getBody alice manager baseUrl)
|
Left res <- runExceptT (getBody alice manager baseUrl)
|
||||||
case res of
|
case res of
|
||||||
InvalidContentTypeHeader "fooooo" _ -> return ()
|
InvalidContentTypeHeader "fooooo" _ -> return ()
|
||||||
|
|
Loading…
Reference in a new issue