Added OperationId combinator

Author: wduncanfraser

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 <https://ietf.org/rfc/rfc2616.html#section-15.1.3> 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)
 

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
 

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.

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)
 

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

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 = OperatorId "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 '[]

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)

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