diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 2c089803..96e8f2a5 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/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, - toQueryParam, toUrlPiece) + WithNamedContext, contentType, getHeadersHList, getResponse, + 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 diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index f79c5e38..16662635 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/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 diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 8aa70c6f..8cec9502 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/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 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index a9971d2c..f5018b3f 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/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) diff --git a/servant/servant.cabal b/servant/servant.cabal index a6d5f285..1cc0209e 100644 --- a/servant/servant.cabal +++ b/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 diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 0c278bea..ed8de4f7 100644 --- a/servant/src/Servant/API.hs +++ b/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 diff --git a/servant/src/Servant/API/OperationId.hs b/servant/src/Servant/API/OperationId.hs index a5fa58f6..a3596ca9 100644 --- a/servant/src/Servant/API/OperationId.hs +++ b/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: -- diff --git a/servant/src/Servant/API/Tags.hs b/servant/src/Servant/API/Tags.hs new file mode 100644 index 00000000..523dee07 --- /dev/null +++ b/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 } \ No newline at end of file