Merge pull request #767 from fierce-katie/docs-combinators

Description and Summary combinators
This commit is contained in:
Oleg Grenrus 2017-08-16 15:31:12 +03:00 committed by GitHub
commit 50be3a263b
10 changed files with 119 additions and 1 deletions

View file

@ -263,6 +263,18 @@ instance HasClient api
clientWithRoute Proxy = clientWithRoute Proxy =
clientWithRoute (Proxy :: Proxy api) 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, -- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'QueryParam', -- an additional argument of the type specified by your 'QueryParam',

View file

@ -807,6 +807,27 @@ instance HasDocs Raw where
docsFor _proxy (endpoint, action) _ = docsFor _proxy (endpoint, action) _ =
single 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 -- 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 -- example data. However, there's no reason to believe that the instances of
-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -7,6 +8,12 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# 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 module Servant.DocsSpec where
import Control.Lens import Control.Lens

View file

@ -350,6 +350,20 @@ instance HasForeign lang ftype api
foreignFor lang ftype Proxy req = foreignFor lang ftype Proxy req =
foreignFor lang ftype (Proxy :: Proxy api) 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 -- | Utility class used by 'listFromAPI' which computes
-- the data needed to generate a function for each endpoint -- the data needed to generate a function for each endpoint
-- and hands it all back in a list. -- and hands it all back in a list.

View file

@ -58,7 +58,8 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth, Capt
IsSecure(..), Header, QueryFlag, IsSecure(..), Header, QueryFlag,
QueryParam, QueryParams, Raw, QueryParam, QueryParams, Raw,
RemoteHost, ReqBody, Vault, RemoteHost, ReqBody, Vault,
WithNamedContext) WithNamedContext,
Description, Summary)
import Servant.API.ContentTypes (AcceptHeader (..), import Servant.API.ContentTypes (AcceptHeader (..),
AllCTRender (..), AllCTRender (..),
AllCTUnrender (..), AllCTUnrender (..),
@ -533,6 +534,18 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where
route Proxy context subserver = route Proxy context subserver =
route (Proxy :: Proxy api) context (passToServer subserver httpVersion) 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. -- | Singleton type representing a server that serves an empty API.
data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum) data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)

View file

@ -10,6 +10,11 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -freduction-depth=100 #-}
#else
{-# OPTIONS_GHC -fcontext-stack=100 #-}
#endif
module Servant.ServerSpec where module Servant.ServerSpec where

View file

@ -38,6 +38,7 @@ library
Servant.API.BasicAuth Servant.API.BasicAuth
Servant.API.Capture Servant.API.Capture
Servant.API.ContentTypes Servant.API.ContentTypes
Servant.API.Description
Servant.API.Empty Servant.API.Empty
Servant.API.Experimental.Auth Servant.API.Experimental.Auth
Servant.API.Header Servant.API.Header

View file

@ -34,6 +34,9 @@ module Servant.API (
-- * Authentication -- * Authentication
module Servant.API.BasicAuth, module Servant.API.BasicAuth,
-- * Endpoints description
module Servant.API.Description,
-- * Content Types -- * Content Types
module Servant.API.ContentTypes, module Servant.API.ContentTypes,
-- | Serializing and deserializing types based on @Accept@ and -- | Serializing and deserializing types based on @Accept@ and
@ -68,6 +71,7 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
MimeRender (..), NoContent (NoContent), MimeRender (..), NoContent (NoContent),
MimeUnrender (..), OctetStream, MimeUnrender (..), OctetStream,
PlainText) PlainText)
import Servant.API.Description (Description, Summary)
import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Empty (EmptyAPI (..))
import Servant.API.Experimental.Auth (AuthProtect) import Servant.API.Experimental.Auth (AuthProtect)
import Servant.API.Header (Header (..)) import Servant.API.Header (Header (..))

View file

@ -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 }

View file

@ -38,6 +38,8 @@ type ComprehensiveAPIWithoutRaw =
Verb 'POST 204 '[JSON] Int :<|> Verb 'POST 204 '[JSON] Int :<|>
WithNamedContext "foo" '[] GET :<|> WithNamedContext "foo" '[] GET :<|>
CaptureAll "foo" Int :> GET :<|> CaptureAll "foo" Int :> GET :<|>
Summary "foo" :> GET :<|>
Description "foo" :> GET :<|>
EmptyAPI EmptyAPI
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw