diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 783072443..96e8f2a57 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/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', diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index d5b51d93a..166626358 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/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 diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 0f3b1248e..8cec95020 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/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. diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index b9a940359..f5018b3f4 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/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) diff --git a/servant/servant.cabal b/servant/servant.cabal index b44f9f482..1cc0209ee 100644 --- a/servant/servant.cabal +++ b/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 diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 772a38878..ed8de4f7b 100644 --- a/servant/src/Servant/API.hs +++ b/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 diff --git a/servant/src/Servant/API/OperationId.hs b/servant/src/Servant/API/OperationId.hs new file mode 100644 index 000000000..a3596ca9c --- /dev/null +++ b/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 } diff --git a/servant/src/Servant/API/Tags.hs b/servant/src/Servant/API/Tags.hs new file mode 100644 index 000000000..523dee078 --- /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 diff --git a/stack.yaml b/stack.yaml index a4855c36a..39f36d9ff 100644 --- a/stack.yaml +++ b/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 \ No newline at end of file