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

Description and Summary combinators

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',

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

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

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.

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)
 

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
 

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

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 (..))

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 }

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