Add OperationId and Tags to identify and group operations, respectively

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

@@ -47,12 +47,12 @@ import           Servant.API
                  EmptyAPI, FramingRender (..), FramingUnrender (..),
                  FromSourceIO (..), Header', Headers (..), HttpVersion,
                  IsSecure, MimeRender (mimeRender),
-                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
-                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
-                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
-                 ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext,
-                 contentType, getHeadersHList, getResponse, toQueryParam,
-                 toUrlPiece)
+                 MimeUnrender (mimeUnrender), NoContent (NoContent), OperationId,
+                 QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..),
+                 RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary,
+                 ToHttpApiData, ToSourceIO (..), Vault, Verb, NoContentVerb,
+                 WithNamedContext, contentType, getHeadersHList, getResponse,
+                 Tags, toQueryParam, toUrlPiece)
 import           Servant.API.ContentTypes
                  (contentTypes)
 import           Servant.API.Modifiers
@@ -404,6 +404,24 @@ 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 desc :> api) where
+  type Client m (OperationId desc :> api) = Client m api
+
+  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
+
+  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
+
+-- | Ignore @'Tags'@ in client functions.
+instance HasClient m api => HasClient m (Tags tags :> api) where
+  type Client m (Tags tags :> 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',

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

@@ -976,6 +976,26 @@ instance (KnownSymbol desc, HasDocs api)
           action' = over notes (|> note) action
           note = DocNote (symbolVal (Proxy :: Proxy desc)) []
 
+instance (KnownSymbol desc, HasDocs api)
+  => HasDocs (OperationId desc :> 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 desc)) []
+
+instance (SymbolVals tags, HasDocs api)
+  => HasDocs (Tags tags :> api) where
+
+  docsFor Proxy (endpoint, action) =
+    docsFor subApiP (endpoint, action')
+
+    where subApiP = Proxy :: Proxy api
+          action' = over notes (|> note) action
+          note = DocNote "Tags" (symbolVals (Proxy :: Proxy tags))
+
 -- 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

@@ -406,6 +406,22 @@ 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 desc :> api) where
+  type Foreign ftype (OperationId desc :> api) = Foreign ftype api
+
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy api) req
+
+instance HasForeign lang ftype api
+  => HasForeign lang ftype (Tags tags :> api) where
+  type Foreign ftype (Tags tags :> 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

@@ -72,11 +72,11 @@ import           Servant.API
                  ((:<|>) (..), (:>), Accept (..), BasicAuth, Capture',
                  CaptureAll, Description, EmptyAPI, FramingRender (..),
                  FramingUnrender (..), FromSourceIO (..), Header', If,
-                 IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,
-                 ReflectMethod (reflectMethod), RemoteHost, ReqBody',
-                 SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',
-                 Summary, ToSourceIO (..), Vault, Verb, NoContentVerb,
-                 WithNamedContext)
+                 IsSecure (..), OperationId, QueryFlag, QueryParam', 
+                 QueryParams, Raw, ReflectMethod (reflectMethod), RemoteHost,
+                 ReqBody', SBool (..), SBoolI (..), SourceIO, Stream, 
+                 StreamBody', Summary, ToSourceIO (..), Vault, Verb, 
+                 NoContentVerb, Tags, WithNamedContext)
 import           Servant.API.ContentTypes
                  (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
                  AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH,
@@ -718,6 +718,21 @@ 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 desc :> api) ctx where
+  type ServerT (OperationId desc :> api) m = ServerT api m
+
+  route _ = route (Proxy :: Proxy api)
+  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s
+
+-- | Ignore @'Tags'@ in server handlers.
+instance HasServer api ctx => HasServer (Tags tags :> api) ctx where
+  type ServerT (Tags tags :> 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/servant.cabal

@@ -57,12 +57,14 @@ library
     Servant.API.IsSecure
     Servant.API.Modifiers
     Servant.API.QueryParam
+    Servant.API.OperationId
     Servant.API.Raw
     Servant.API.RemoteHost
     Servant.API.ReqBody
     Servant.API.ResponseHeaders
     Servant.API.Stream
     Servant.API.Sub
+    Servant.API.Tags
     Servant.API.TypeLevel
     Servant.API.Vault
     Servant.API.Verbs

servant/src/Servant/API.hs

@@ -42,6 +42,12 @@ module Servant.API (
   -- * Endpoints description
   module Servant.API.Description,
 
+  -- * Endpoints operation id
+  module Servant.API.OperationId,
+
+  -- * Endpoints tags
+  module Servant.API.Tags,
+
   -- * Content Types
   module Servant.API.ContentTypes,
   -- | Serializing and deserializing types based on @Accept@ and
@@ -100,6 +106,8 @@ import           Servant.API.IsSecure
                  (IsSecure (..))
 import           Servant.API.Modifiers
                  (Lenient, Optional, Required, Strict)
+import           Servant.API.OperationId
+                 (OperationId)
 import           Servant.API.QueryParam
                  (QueryFlag, QueryParam, QueryParam', QueryParams)
 import           Servant.API.Raw
@@ -120,6 +128,8 @@ import           Servant.API.Stream
                  ToSourceIO (..))
 import           Servant.API.Sub
                  ((:>))
+import           Servant.API.Tags
+                 (SymbolVals(..), Tags)
 import           Servant.API.Vault
                  (Vault)
 import           Servant.API.Verbs

servant/src/Servant/API/OperationId.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+module Servant.API.OperationId (
+    -- * Combinators
+    OperationId,
+    ) where
+
+import           Data.Typeable
+                 (Typeable)
+import           GHC.TypeLits
+                 (Symbol)
+
+-- | Add an operation Id for (part of) API.
+--
+-- Example:
+--
+-- >>> type MyApi = OperationId "getBookById" :> "books" :> Capture "id" Int :> Get '[JSON] Book
+data OperationId (sym :: Symbol)
+    deriving (Typeable)
+
+-- $setup
+-- >>> import Servant.API
+-- >>> import Data.Aeson
+-- >>> import Data.Text
+-- >>> data Book
+-- >>> instance ToJSON Book where { toJSON = undefined }
+-- >>> data SourceFile
+-- >>> instance ToJSON SourceFile where { toJSON = undefined }

servant/src/Servant/API/Tags.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# OPTIONS_HADDOCK not-home    #-}
+module Servant.API.Tags (
+    SymbolVals(..),
+    -- * Combinators
+    Tags,
+    ) where
+
+import           Data.Proxy
+                 (Proxy (..))
+import           Data.Typeable
+                 (Typeable)
+import           GHC.TypeLits
+                 (KnownSymbol, Symbol, symbolVal)
+
+-- | Add tags for (part of) API.
+--
+-- Example:
+--
+-- >>> type MyApi = Tags '["Books"] :> "books" :> Capture "id" Int :> Get '[JSON] Book
+class SymbolVals a where
+    symbolVals :: proxy a -> [String]
+
+instance SymbolVals '[] where
+    symbolVals _ = []
+
+instance (KnownSymbol h, SymbolVals t) => SymbolVals (h ': t) where
+    symbolVals _ = symbolVal (Proxy :: Proxy h) : symbolVals (Proxy :: Proxy t)
+
+data Tags (tags :: [Symbol])
+    deriving (Typeable)
+
+-- $setup
+-- >>> import Servant.API
+-- >>> import Data.Aeson
+-- >>> import Data.Text
+-- >>> data Book
+-- >>> instance ToJSON Book where { toJSON = undefined }
+-- >>> data SourceFile
+-- >>> instance ToJSON SourceFile where { toJSON = undefined }

stack.yaml

@@ -29,4 +29,4 @@ extra-deps:
 - resourcet-1.2.2
 - sop-core-0.4.0.0
 - wai-extra-3.0.24.3
-- tasty-1.1.0.4
+- tasty-1.1.0.4