From 601559c0b5d3127b6776e1881355af87bf366d80 Mon Sep 17 00:00:00 2001 From: "W. Duncan Fraser" Date: Mon, 7 Dec 2020 18:04:26 -0600 Subject: [PATCH 1/2] Added OperationId combinator --- .../src/Servant/Client/Core/HasClient.hs | 22 +++++++++++++------ servant-docs/src/Servant/Docs/Internal.hs | 10 +++++++++ .../src/Servant/Foreign/Internal.hs | 7 ++++++ servant-server/src/Servant/Server/Internal.hs | 15 +++++++++---- servant/src/Servant/API.hs | 2 +- servant/src/Servant/API/Description.hs | 8 +++++++ servant/src/Servant/Links.hs | 6 ++++- servant/src/Servant/Test/ComprehensiveAPI.hs | 1 + 8 files changed, 58 insertions(+), 13 deletions(-) diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index a030a2424..63da23f9a 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -72,11 +72,11 @@ import Servant.API FromSourceIO (..), Header', Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent (NoContent), - NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, - ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, - StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault, - Verb, WithNamedContext, contentType, getHeadersHList, - getResponse, toQueryParam, toUrlPiece) + NoContentVerb, OperationId, QueryFlag, QueryParam', + QueryParams, Raw, ReflectMethod (..), RemoteHost, ReqBody', + SBoolI, Stream, StreamBody', Summary, ToHttpApiData, + ToSourceIO (..), Vault, Verb, WithNamedContext, contentType, + getHeadersHList, getResponse, toQueryParam, toUrlPiece) import Servant.API.ContentTypes (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender)) import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment) @@ -496,6 +496,14 @@ instance HasClient m api => HasClient m (Description desc :> api) where hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl +-- | Ignore @'OperationId'@ in client functions. +instance HasClient m api => HasClient m (OperationId opid :> api) where + type Client m (OperationId opid :> api) = Client m api + + clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) + + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl + -- | If you use a 'QueryParam' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'QueryParam', @@ -753,7 +761,7 @@ instance ( HasClient m api -- | Ignore @'Fragment'@ in client functions. -- See for more details. --- +-- -- Example: -- -- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book] @@ -774,7 +782,7 @@ instance ( HasClient m api type Client m (Fragment a :> api) = Client m api - clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) + clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api) diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index b36ad88bc..6796a8ab8 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -1020,6 +1020,16 @@ instance (KnownSymbol desc, HasDocs api) action' = over notes (|> note) action note = DocNote (symbolVal (Proxy :: Proxy desc)) [] +instance (KnownSymbol opid, HasDocs api) + => HasDocs (OperationId opid :> api) where + + docsFor Proxy (endpoint, action) = + docsFor subApiP (endpoint, action') + + where subApiP = Proxy :: Proxy api + action' = over notes (|> note) action + note = DocNote (symbolVal (Proxy :: Proxy opid)) [] + instance (KnownSymbol desc, HasDocs api) => HasDocs (Summary desc :> api) where diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 22f37ad96..5a0d81526 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -422,6 +422,13 @@ instance HasForeign lang ftype api foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) req +instance HasForeign lang ftype api + => HasForeign lang ftype (OperationId opid :> api) where + type Foreign ftype (OperationId opid :> api) = Foreign ftype api + + foreignFor lang ftype Proxy req = + foreignFor lang ftype (Proxy :: Proxy api) req + -- | Utility class used by 'listFromAPI' which computes -- the data needed to generate a function for each endpoint -- and hands it all back in a list. diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 9579367f0..0ad968c61 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -74,10 +74,10 @@ import Servant.API CaptureAll, Description, EmptyAPI, Fragment, FramingRender (..), FramingUnrender (..), FromSourceIO (..), Header', If, IsSecure (..), NoContentVerb, QueryFlag, - QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod), - RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO, - Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb, - WithNamedContext) + OperationId, QueryParam', QueryParams, Raw, + ReflectMethod (reflectMethod), RemoteHost, ReqBody', + SBool (..), SBoolI (..), SourceIO, Stream, StreamBody', + Summary, ToSourceIO (..), Vault, Verb, WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..), AllMime, MimeRender (..), MimeUnrender (..), NoContent, @@ -745,6 +745,13 @@ instance HasServer api ctx => HasServer (Description desc :> api) ctx where route _ = route (Proxy :: Proxy api) hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s +-- Ignore @'OperationId'@ in server handlers +instance HasServer api ctx => HasServer (OperationId opid :> api) ctx where + type ServerT (OperationId opid :> api) m = ServerT api m + + route _ = route (Proxy :: Proxy api) + hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s + -- | Singleton type representing a server that serves an empty API. data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum) diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index deb974ae7..3029d3ef7 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -90,7 +90,7 @@ import Servant.API.ContentTypes MimeUnrender (..), NoContent (NoContent), OctetStream, PlainText) import Servant.API.Description - (Description, Summary) + (Description, OperationId, Summary) import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Experimental.Auth diff --git a/servant/src/Servant/API/Description.hs b/servant/src/Servant/API/Description.hs index 18c54322f..698710d12 100644 --- a/servant/src/Servant/API/Description.hs +++ b/servant/src/Servant/API/Description.hs @@ -9,6 +9,7 @@ module Servant.API.Description ( -- * Combinators Description, + OperationId, Summary, -- * Used as modifiers FoldDescription, @@ -46,6 +47,13 @@ data Summary (sym :: Symbol) data Description (sym :: Symbol) deriving (Typeable) +-- | Add a unique identifier for an endpoint +-- +-- Example: +-- +-- >>> type MyApi = OperationId "getBooksByISBN" :> "books" :> Capture "isbn" Text :> Get '[JSON] Book +data OperationId (sym :: Symbol) + -- | Fold list of modifiers to extract description as a type-level String. -- -- >>> :kind! FoldDescription '[] diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index bfd47206f..2b5a176ac 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -149,7 +149,7 @@ import Servant.API.BasicAuth import Servant.API.Capture (Capture', CaptureAll) import Servant.API.Description - (Description, Summary) + (Description, OperationId, Summary) import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Experimental.Auth @@ -532,6 +532,10 @@ instance HasLink sub => HasLink (Description s :> sub) where type MkLink (Description s :> sub) a = MkLink sub a toLink = simpleToLink (Proxy :: Proxy sub) +instance HasLink sub => HasLink (OperationId opid :> sub) where + type MkLink (OperationId opid :> sub) a = MkLink sub a + toLink = simpleToLink (Proxy :: Proxy sub) + instance HasLink sub => HasLink (Summary s :> sub) where type MkLink (Summary s :> sub) a = MkLink sub a toLink = simpleToLink (Proxy :: Proxy sub) diff --git a/servant/src/Servant/Test/ComprehensiveAPI.hs b/servant/src/Servant/Test/ComprehensiveAPI.hs index 2c1b02a3b..94b82e9cc 100644 --- a/servant/src/Servant/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/Test/ComprehensiveAPI.hs @@ -70,6 +70,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint = :<|> "capture-all" :> CaptureAll "foo" Int :> GET :<|> "summary" :> Summary "foo" :> GET :<|> "description" :> Description "foo" :> GET + :<|> "operation-id" :> OperationId "getFoo" :> GET :<|> "alternative" :> ("left" :> GET :<|> "right" :> GET) :<|> "fragment" :> Fragment Int :> GET :<|> endpoint From a7f1534817dce8864387b489012cd545b765169b Mon Sep 17 00:00:00 2001 From: "W. Duncan Fraser" Date: Tue, 8 Dec 2020 10:21:19 -0600 Subject: [PATCH 2/2] Fixed servant-docs tests for OperatorId --- servant-docs/golden/comprehensive.md | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/servant-docs/golden/comprehensive.md b/servant-docs/golden/comprehensive.md index 7d2245021..78822966a 100644 --- a/servant-docs/golden/comprehensive.md +++ b/servant-docs/golden/comprehensive.md @@ -304,6 +304,27 @@ ## GET /named-context +### Response: + +- Status code 200 +- Headers: [] + +- Supported content types are: + + - `application/json;charset=utf-8` + - `application/json` + +- Example (`application/json;charset=utf-8`, `application/json`): + +```javascript + +``` + +## GET /operation-id + +### getFoo + + ### Response: - Status code 200