From 2e59a82d012bf670b015e4ee69efe1e740060a15 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Thu, 8 Jun 2017 17:35:24 +0300 Subject: [PATCH 1/5] Add Description and Summary combinators --- servant/servant.cabal | 1 + servant/src/Servant/API.hs | 4 +++ servant/src/Servant/API/Description.hs | 32 +++++++++++++++++++ .../API/Internal/Test/ComprehensiveAPI.hs | 2 ++ 4 files changed, 39 insertions(+) create mode 100644 servant/src/Servant/API/Description.hs diff --git a/servant/servant.cabal b/servant/servant.cabal index 5efd1f12..7f25bdb9 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..45dfb7fa --- /dev/null +++ b/servant/src/Servant/API/Description.hs @@ -0,0 +1,32 @@ +{-# 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 "Some longer implementation details here." :> "books" :> Capture "isbn" Text :> 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 From ec0431d9308661657bcc97191c039149c2717092 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Thu, 8 Jun 2017 18:27:36 +0300 Subject: [PATCH 2/5] Add instances for new combinators --- servant-client/src/Servant/Client.hs | 12 +++++++++++ servant-docs/src/Servant/Docs/Internal.hs | 21 +++++++++++++++++++ .../src/Servant/Foreign/Internal.hs | 14 +++++++++++++ servant-server/src/Servant/Server/Internal.hs | 15 ++++++++++++- 4 files changed, 61 insertions(+), 1 deletion(-) 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 7cdbef80..db29ab86 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -798,6 +798,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-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) From 272e47c3d39efa250e250af985cd0dfa39b35d15 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Mon, 19 Jun 2017 14:59:26 +0300 Subject: [PATCH 3/5] Increase stack size for GHC-7.8.4 tests --- servant-docs/test/Servant/DocsSpec.hs | 19 ++++++++++--------- servant-server/test/Servant/ServerSpec.hs | 1 + 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 3daffbcf..7bc62672 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fcontext-stack=100 #-} module Servant.DocsSpec where import Control.Lens diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 0a641559..da483e4e 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -10,6 +10,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fcontext-stack=100 #-} module Servant.ServerSpec where From 262453b0d1d1a90706c9f869e5135cac617ec44f Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Mon, 19 Jun 2017 16:39:05 +0300 Subject: [PATCH 4/5] Add multiline Description example --- servant/src/Servant/API/Description.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/servant/src/Servant/API/Description.hs b/servant/src/Servant/API/Description.hs index 45dfb7fa..1f3b408e 100644 --- a/servant/src/Servant/API/Description.hs +++ b/servant/src/Servant/API/Description.hs @@ -18,7 +18,14 @@ data Summary (sym :: Symbol) -- -- Example: -- --- >>> type MyApi = Description "Some longer implementation details here." :> "books" :> Capture "isbn" Text :> Get '[JSON] Book +-- >>> :{ +--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) From be0878cdd84fd0870c9e1ac0835ca8f3f56f7b26 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Mon, 19 Jun 2017 18:58:25 +0300 Subject: [PATCH 5/5] Fix tests for different GHC versions --- servant-docs/test/Servant/DocsSpec.hs | 24 ++++++++++++++--------- servant-server/test/Servant/ServerSpec.hs | 4 ++++ 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 7bc62672..370e2306 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -1,13 +1,19 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index da483e4e..49bde8ca 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -10,7 +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