diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index dfe2721c..b79fcf08 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -263,6 +263,18 @@ instance HasClient api clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api) +-- | Ignore @'Summary'@ in client functions. +instance HasClient api => HasClient (Summary desc :> api) where + type Client (Summary desc :> api) = Client api + + clientWithRoute _ = clientWithRoute (Proxy :: Proxy api) + +-- | Ignore @'Description'@ in client functions. +instance HasClient api => HasClient (Description desc :> api) where + type Client (Description desc :> api) = Client api + + clientWithRoute _ = clientWithRoute (Proxy :: Proxy api) + -- | 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 caf06365..ea85f22d 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -807,6 +807,27 @@ instance HasDocs Raw where docsFor _proxy (endpoint, action) _ = single endpoint action + +instance (KnownSymbol desc, HasDocs api) + => HasDocs (Description 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 (KnownSymbol desc, HasDocs api) + => HasDocs (Summary 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-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 3daffbcf..370e2306 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} @@ -7,6 +8,12 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=100 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=100 #-} +#endif + module Servant.DocsSpec where import Control.Lens diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index fd12befd..b0a3410f 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -350,6 +350,20 @@ 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 (Summary desc :> api) where + type Foreign ftype (Summary 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 (Description desc :> api) where + type Foreign ftype (Description 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 d336fb0f..b6656fb8 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -58,7 +58,8 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth, Capt IsSecure(..), Header, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, Vault, - WithNamedContext) + WithNamedContext, + Description, Summary) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..), @@ -533,6 +534,18 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where route Proxy context subserver = route (Proxy :: Proxy api) context (passToServer subserver httpVersion) +-- | Ignore @'Summary'@ in server handlers. +instance HasServer api ctx => HasServer (Summary desc :> api) ctx where + type ServerT (Summary desc :> api) m = ServerT api m + + route _ = route (Proxy :: Proxy api) + +-- | Ignore @'Description'@ in server handlers. +instance HasServer api ctx => HasServer (Description desc :> api) ctx where + type ServerT (Description desc :> api) m = ServerT api m + + route _ = route (Proxy :: Proxy api) + -- | Singleton type representing a server that serves an empty API. data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum) diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 0a641559..49bde8ca 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -10,6 +10,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS_GHC -freduction-depth=100 #-} +#else +{-# OPTIONS_GHC -fcontext-stack=100 #-} +#endif module Servant.ServerSpec where diff --git a/servant/servant.cabal b/servant/servant.cabal index 434e3649..fbd4d714 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -38,6 +38,7 @@ library Servant.API.BasicAuth Servant.API.Capture Servant.API.ContentTypes + Servant.API.Description Servant.API.Empty Servant.API.Experimental.Auth Servant.API.Header diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index f1a0e64b..88e4d934 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -34,6 +34,9 @@ module Servant.API ( -- * Authentication module Servant.API.BasicAuth, + -- * Endpoints description + module Servant.API.Description, + -- * Content Types module Servant.API.ContentTypes, -- | Serializing and deserializing types based on @Accept@ and @@ -68,6 +71,7 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded, MimeRender (..), NoContent (NoContent), MimeUnrender (..), OctetStream, PlainText) +import Servant.API.Description (Description, Summary) import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Experimental.Auth (AuthProtect) import Servant.API.Header (Header (..)) diff --git a/servant/src/Servant/API/Description.hs b/servant/src/Servant/API/Description.hs new file mode 100644 index 00000000..1f3b408e --- /dev/null +++ b/servant/src/Servant/API/Description.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} +{-# OPTIONS_HADDOCK not-home #-} +module Servant.API.Description (Description, Summary) where + +import Data.Typeable (Typeable) +import GHC.TypeLits (Symbol) +-- | Add a short summary for (part of) API. +-- +-- Example: +-- +-- >>> type MyApi = Summary "Get book by ISBN." :> "books" :> Capture "isbn" Text :> Get '[JSON] Book +data Summary (sym :: Symbol) + deriving (Typeable) + +-- | Add more verbose description for (part of) API. +-- +-- Example: +-- +-- >>> :{ +--type MyApi = Description +-- "This comment is visible in multiple Servant interpretations \ +-- \and can be really long if necessary. \ +-- \Haskell multiline support is not perfect \ +-- \but it's still very readable." +-- :> Get '[JSON] Book +-- :} +data Description (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/Internal/Test/ComprehensiveAPI.hs b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs index 0f39a910..cf3e1213 100644 --- a/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs @@ -38,6 +38,8 @@ type ComprehensiveAPIWithoutRaw = Verb 'POST 204 '[JSON] Int :<|> WithNamedContext "foo" '[] GET :<|> CaptureAll "foo" Int :> GET :<|> + Summary "foo" :> GET :<|> + Description "foo" :> GET :<|> EmptyAPI comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw