Add OperationId (#1844)

* Add `OperationId`

* Update servant/src/Servant/API/Description.hs

Co-authored-by: Clément Delafargue <[email protected]>

---------

Co-authored-by: Clément Delafargue <[email protected]>

Author: blackheaven

changelog.d/pr-1844

@@ -0,0 +1,7 @@
+synopsis: Add support for `OperationId`
+packages: servant, servant-client, servant-docs, servant-server, servant-swagger
+prs: #1844
+issues: N/A
+description: {
+  Add `OperationId`, which can direct code and docs generation.
+}

servant-client-core/src/Servant/Client/Core/HasClient.hs

@@ -66,6 +66,7 @@ import Servant.API
   , NamedRoutes
   , NoContent (NoContent)
   , NoContentVerb
+  , OperationId
   , QueryFlag
   , QueryParam'
   , QueryParams
@@ -723,6 +724,14 @@ instance HasClient m api => HasClient m (Summary desc :> api) where
 
   hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
 
+-- | Ignore @'OperationId'@ in client functions.
+instance HasClient m api => HasClient m (OperationId operationId :> api) where
+  type Client m (OperationId operationId :> api) = Client m api
+
+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
+
+  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
+
 -- | Ignore @'Description'@ in client functions.
 instance HasClient m api => HasClient m (Description desc :> api) where
   type Client m (Description desc :> api) = Client m api

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`):
+
+```json
+
+```
+
+## GET /operation-id
+
+### OperationId: foo
+
+
 ### Response:
 
 - Status code 200

servant-docs/src/Servant/Docs/Internal.hs

@@ -1181,6 +1181,17 @@ instance
       action' = over notes (|> note) action
       note = DocNote (symbolVal (Proxy :: Proxy desc)) []
 
+instance
+  (HasDocs api, KnownSymbol operationId)
+  => HasDocs (OperationId operationId :> api)
+  where
+  docsFor Proxy (endpoint, action) =
+    docsFor subApiP (endpoint, action')
+    where
+      subApiP = Proxy :: Proxy api
+      action' = over notes (|> note) action
+      note = DocNote ("OperationId: " <> symbolVal (Proxy :: Proxy operationId)) []
+
 -- TODO: We use 'AllMimeRender' here because we need to be able to show the
 -- example data. However, there's no reason to believe that the instances of
 -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -558,6 +558,19 @@ instance
 
   foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
 
+instance
+  (HasForeign lang ftype api, KnownSymbol operationId)
+  => HasForeign lang ftype (OperationId operationId :> api)
+  where
+  type Foreign ftype (OperationId operationId :> api) = Foreign ftype api
+
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy api) $
+      req
+        & reqFuncName . _FunctionName .~ [str]
+    where
+      str = pack . symbolVal $ (Proxy :: Proxy operationId)
+
 instance
   HasForeign lang ftype api
   => HasForeign lang ftype (Description desc :> api)

servant-server/src/Servant/Server/Internal.hs

@@ -82,6 +82,7 @@ import Servant.API
   , IsSecure (..)
   , NamedRoutes
   , NoContentVerb
+  , OperationId
   , QueryFlag
   , QueryParam'
   , QueryParams
@@ -1131,6 +1132,13 @@ instance HasServer api ctx => HasServer (Summary desc :> api) ctx where
   route _ = route (Proxy :: Proxy api)
   hoistServerWithContext _ = hoistServerWithContext (Proxy :: Proxy api)
 
+-- | Ignore @'OperationId'@ in server handlers.
+instance HasServer api ctx => HasServer (OperationId operationId :> api) ctx where
+  type ServerT (OperationId operationId :> api) m = ServerT api m
+
+  route _ = route (Proxy :: Proxy api)
+  hoistServerWithContext _ = hoistServerWithContext (Proxy :: Proxy api)
+
 -- | Ignore @'Description'@ in server handlers.
 instance HasServer api ctx => HasServer (Description desc :> api) ctx where
   type ServerT (Description desc :> api) m = ServerT api m

servant-swagger/src/Servant/Swagger/Internal.hs

@@ -389,6 +389,11 @@ instance (HasSwagger api, KnownSymbol desc) => HasSwagger (Summary desc :> api)
     toSwagger (Proxy :: Proxy api)
       & allOperations . summary %~ (Just (Text.pack (symbolVal (Proxy :: Proxy desc))) <>)
 
+instance (HasSwagger api, KnownSymbol operationId) => HasSwagger (OperationId operationId :> api) where
+  toSwagger _ =
+    toSwagger (Proxy :: Proxy api)
+      & allOperations . operationId %~ (Just (Text.pack (symbolVal (Proxy :: Proxy operationId))) <>)
+
 instance (HasSwagger sub, KnownSymbol (FoldDescription mods), KnownSymbol sym, SBoolI (FoldRequired mods), ToParamSchema a) => HasSwagger (QueryParam' mods sym a :> sub) where
   toSwagger _ =
     toSwagger (Proxy :: Proxy sub)

servant/src/Servant/API.hs

@@ -105,7 +105,7 @@ import Servant.API.ContentTypes
   , OctetStream
   , PlainText
   )
-import Servant.API.Description (Description, Summary)
+import Servant.API.Description (Description, OperationId, Summary)
 import Servant.API.Empty (EmptyAPI (..))
 import Servant.API.Experimental.Auth (AuthProtect)
 import Servant.API.Fragment (Fragment)

servant/src/Servant/API/Description.hs

@@ -11,6 +11,7 @@ module Servant.API.Description
   ( -- * Combinators
     Description
   , Summary
+  , OperationId
 
     -- * Used as modifiers
   , FoldDescription
@@ -47,6 +48,14 @@ data Summary (sym :: Symbol)
 data Description (sym :: Symbol)
   deriving (Typeable)
 
+-- | Add an (unchecked) operation id for (part of) API, useful when generating bindings and OpenAPI docs.
+--
+-- Example:
+--
+-- >>> type MyApi = OperationId "getBookByISBN" :> "books" :> Capture "isbn" Text :> Get '[JSON] Book
+data OperationId (sym :: Symbol)
+  deriving (Typeable)
+
 -- | Fold list of modifiers to extract description as a type-level String.
 --
 -- >>> :kind! FoldDescription '[]

servant/src/Servant/Links.hs

@@ -139,7 +139,7 @@ import Web.HttpApiData
 import Servant.API.Alternative ((:<|>) ((:<|>)))
 import Servant.API.BasicAuth (BasicAuth)
 import Servant.API.Capture (Capture', CaptureAll)
-import Servant.API.Description (Description, Summary)
+import Servant.API.Description (Description, OperationId, Summary)
 import Servant.API.Empty (EmptyAPI (..))
 import Servant.API.Experimental.Auth (AuthProtect)
 import Servant.API.Fragment (Fragment)
@@ -550,6 +550,10 @@ instance HasLink sub => HasLink (Summary s :> sub) where
   type MkLink (Summary s :> sub) a = MkLink sub a
   toLink = simpleToLink (Proxy :: Proxy sub)
 
+instance HasLink sub => HasLink (OperationId s :> sub) where
+  type MkLink (OperationId s :> sub) a = MkLink sub a
+  toLink = simpleToLink (Proxy :: Proxy sub)
+
 instance HasLink sub => HasLink (HttpVersion :> sub) where
   type MkLink (HttpVersion :> sub) a = MkLink sub a
   toLink = simpleToLink (Proxy :: Proxy sub)