Add Tags to group operations

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

@@ -48,11 +48,11 @@ import           Servant.API
                  FromSourceIO (..), Header', Headers (..), HttpVersion,
                  IsSecure, MimeRender (mimeRender),
                  MimeUnrender (mimeUnrender), NoContent (NoContent), OperationId,
-                 QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..), 
+                 QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..),
                  RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary,
                  ToHttpApiData, ToSourceIO (..), Vault, Verb, NoContentVerb,
-                 WithNamedContext, contentType, getHeadersHList, getResponse, 
+                 WithNamedContext, contentType, getHeadersHList, getResponse,
-                 toQueryParam, toUrlPiece)
+                 Tags, toQueryParam, toUrlPiece)
 import           Servant.API.ContentTypes
                  (contentTypes)
 import           Servant.API.Modifiers
@@ -412,6 +412,15 @@ instance HasClient m api => HasClient m (OperationId desc :> api) where
 
   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

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

@@ -986,6 +986,16 @@ instance (KnownSymbol desc, HasDocs 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

@@ -413,6 +413,14 @@ 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 (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

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

@@ -76,7 +76,7 @@ import           Servant.API
                  QueryParams, Raw, ReflectMethod (reflectMethod), RemoteHost,
                  ReqBody', SBool (..), SBoolI (..), SourceIO, Stream, 
                  StreamBody', Summary, ToSourceIO (..), Vault, Verb, 
-                 NoContentVerb, WithNamedContext)
+                 NoContentVerb, Tags, WithNamedContext)
 import           Servant.API.ContentTypes
                  (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
                  AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH,
@@ -725,6 +725,13 @@ instance HasServer api ctx => HasServer (OperationId desc :> api) ctx where
   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

@@ -64,6 +64,7 @@ library
     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

@@ -45,6 +45,9 @@ module Servant.API (
   -- * 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
@@ -103,10 +106,10 @@ import           Servant.API.IsSecure
                  (IsSecure (..))
 import           Servant.API.Modifiers
                  (Lenient, Optional, Required, Strict)
-import           Servant.API.QueryParam
-                 (QueryFlag, QueryParam, QueryParam', QueryParams)
 import           Servant.API.OperationId
                  (OperationId)
+import           Servant.API.QueryParam
+                 (QueryFlag, QueryParam, QueryParam', QueryParams)
 import           Servant.API.Raw
                  (Raw)
 import           Servant.API.RemoteHost
@@ -125,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

@@ -15,7 +15,7 @@ import           Data.Typeable
 import           GHC.TypeLits
                  (Symbol)
 
--- | Add an operationId for a specific endpoint of an API.
+-- | Add an operation Id for (part of) API.
 --
 -- Example:
 --

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 }