From 9fa76c859fa1a80cd1d51a5643125e4999bf9760 Mon Sep 17 00:00:00 2001 From: acentelles Date: Mon, 4 Nov 2019 14:12:46 +0000 Subject: [PATCH 1/2] Add ID to indentify an operation --- .../src/Servant/Client/Core/HasClient.hs | 21 ++++++++---- servant-docs/src/Servant/Docs/Internal.hs | 10 ++++++ .../src/Servant/Foreign/Internal.hs | 8 +++++ servant-server/src/Servant/Server/Internal.hs | 18 +++++++--- servant/servant.cabal | 1 + servant/src/Servant/API.hs | 5 +++ servant/src/Servant/API/OperationId.hs | 33 +++++++++++++++++++ stack.yaml | 2 +- 8 files changed, 86 insertions(+), 12 deletions(-) create mode 100644 servant/src/Servant/API/OperationId.hs diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 783072443..2c0898031 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, + toQueryParam, toUrlPiece) import Servant.API.ContentTypes (contentTypes) import Servant.API.Modifiers @@ -404,6 +404,15 @@ 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 + + -- | 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..f79c5e382 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -976,6 +976,16 @@ 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)) [] + -- 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..8aa70c6f0 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -406,6 +406,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 (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 + + -- | 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..a9971d2c6 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, WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..), AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH, @@ -718,6 +718,14 @@ 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 + + -- | 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..a6d5f2851 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -57,6 +57,7 @@ library Servant.API.IsSecure Servant.API.Modifiers Servant.API.QueryParam + Servant.API.OperationId Servant.API.Raw Servant.API.RemoteHost Servant.API.ReqBody diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 772a38878..0c278beac 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -42,6 +42,9 @@ module Servant.API ( -- * Endpoints description module Servant.API.Description, + -- * Endpoints operation id + module Servant.API.OperationId, + -- * Content Types module Servant.API.ContentTypes, -- | Serializing and deserializing types based on @Accept@ and @@ -102,6 +105,8 @@ import Servant.API.Modifiers (Lenient, Optional, Required, Strict) import Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams) +import Servant.API.OperationId + (OperationId) import Servant.API.Raw (Raw) import Servant.API.RemoteHost diff --git a/servant/src/Servant/API/OperationId.hs b/servant/src/Servant/API/OperationId.hs new file mode 100644 index 000000000..a5fa58f67 --- /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 operationId for a specific endpoint of an 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/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 From 6ae49bc7ca9dc9a607c4235e161e809f07f8095d Mon Sep 17 00:00:00 2001 From: acentelles Date: Mon, 4 Nov 2019 14:49:19 +0000 Subject: [PATCH 2/2] Add Tags to group operations --- .../src/Servant/Client/Core/HasClient.hs | 15 +++++-- servant-docs/src/Servant/Docs/Internal.hs | 10 +++++ .../src/Servant/Foreign/Internal.hs | 8 ++++ servant-server/src/Servant/Server/Internal.hs | 9 +++- servant/servant.cabal | 1 + servant/src/Servant/API.hs | 9 +++- servant/src/Servant/API/OperationId.hs | 2 +- servant/src/Servant/API/Tags.hs | 45 +++++++++++++++++++ 8 files changed, 92 insertions(+), 7 deletions(-) create mode 100644 servant/src/Servant/API/Tags.hs diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 2c0898031..96e8f2a57 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 f79c5e382..166626358 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 8aa70c6f0..8cec95020 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 a9971d2c6..f5018b3f4 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 a6d5f2851..1cc0209ee 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 0c278beac..ed8de4f7b 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 a5fa58f67..a3596ca9c 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 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