Add description modifier helpers and parametrise Capture

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs

@@ -34,7 +34,7 @@ import           Servant.API                            ((:<|>) ((:<|>)), (:>),
                                                          BuildHeadersTo (..),
                                                          BuildFromStream (..),
                                                          ByteStringParser (..),
-                                                         Capture, CaptureAll,
+                                                         Capture', CaptureAll,
                                                          Description, EmptyAPI,
                                                          FramingUnrender (..),
                                                          Header', Headers (..),
@@ -155,9 +155,9 @@ instance RunClient m => HasClient m EmptyAPI where
 -- > getBook = client myApi
 -- > -- then you can just use "getBook" to query that endpoint
 instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
-      => HasClient m (Capture capture a :> api) where
+      => HasClient m (Capture' mods capture a :> api) where
 
-  type Client m (Capture capture a :> api) =
+  type Client m (Capture' mods capture a :> api) =
     a -> Client m api
 
   clientWithRoute pm Proxy req val =

servant-docs/src/Servant/Docs/Internal.hs

@@ -795,7 +795,7 @@ instance HasDocs EmptyAPI where
 -- | @"books" :> 'Capture' "isbn" Text@ will appear as
 -- @/books/:isbn@ in the docs.
 instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
-      => HasDocs (Capture sym a :> api) where
+      => HasDocs (Capture' mods sym a :> api) where
 
   docsFor Proxy (endpoint, action) =
     docsFor subApiP (endpoint', action')

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -195,8 +195,8 @@ instance HasForeign lang ftype EmptyAPI where
   foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI
 
 instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
-  => HasForeign lang ftype (Capture sym t :> api) where
+  => HasForeign lang ftype (Capture' mods sym t :> api) where
-  type Foreign ftype (Capture sym t :> api) = Foreign ftype api
+  type Foreign ftype (Capture' mods sym t :> api) = Foreign ftype api
 
   foreignFor lang Proxy Proxy req =
     foreignFor lang Proxy (Proxy :: Proxy api) $

servant-server/src/Servant/Server/Internal.hs

@@ -67,7 +67,7 @@ import           Web.HttpApiData            (FromHttpApiData, parseHeader,
                                              parseQueryParam,
                                              parseUrlPieceMaybe,
                                              parseUrlPieces)
-import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capture,
+import           Servant.API                 ((:<|>) (..), (:>), BasicAuth, Capture',
                                               CaptureAll, Verb, EmptyAPI,
                                               ReflectMethod(reflectMethod),
                                               IsSecure(..), Header', QueryFlag,
@@ -164,9 +164,9 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
 -- >   where getBook :: Text -> Handler Book
 -- >         getBook isbn = ...
 instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
-      => HasServer (Capture capture a :> api) context where
+      => HasServer (Capture' mods capture a :> api) context where
 
-  type ServerT (Capture capture a :> api) m =
+  type ServerT (Capture' mods capture a :> api) m =
      a -> ServerT api m
 
   hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
@@ -749,14 +749,14 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
 -- ...
 -- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
 -- ...Maybe you haven't applied enough arguments to
--- ...Capture "foo"
+-- ...Capture' '[] "foo"
 -- ...
 --
 -- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
 -- ...
 -- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
 -- ...Maybe you haven't applied enough arguments to
--- ...Capture "foo"
+-- ...Capture' '[] "foo"
 -- ...
 -- 
 instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
@@ -778,7 +778,7 @@ type HasServerArrowKindError arr =
 -- ...
 -- ...No instance HasServer (a -> b).
 -- ...Maybe you have used '->' instead of ':>' between
--- ...Capture "foo" Int
+-- ...Capture' '[] "foo" Int
 -- ...and
 -- ...Verb 'GET 200 '[JSON] Int
 -- ...
@@ -787,7 +787,7 @@ type HasServerArrowKindError arr =
 -- ...
 -- ...No instance HasServer (a -> b).
 -- ...Maybe you have used '->' instead of ':>' between
--- ...Capture "foo" Int
+-- ...Capture' '[] "foo" Int
 -- ...and
 -- ...Verb 'GET 200 '[JSON] Int
 -- ...

servant/CHANGELOG.md

@@ -18,12 +18,16 @@
   - [Querying an API - Querying Streaming APIs](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/Client.html#querying-streaming-apis)
 
 - *servant* Add `Servant.API.Modifiers`
-  ([#873](https://github.com/haskell-servant/servant/pull/873))
+  ([#873](https://github.com/haskell-servant/servant/pull/873)
+   [#903](https://github.com/haskell-servant/servant/pull/903))
 
   `QueryParam`, `Header` and `ReqBody` understand modifiers:
   - `Required` or `Optional` (resulting in `a` or `Maybe a` in handlers)
   - `Strict` or `Lenient` (resulting in `a` or `Either String a` in handlers)
 
+  Also you can use `Description` as a modifier, but it doesn't yet work
+  with `servant-docs`, only `servant-swagger`. [There is an issue.](https://github.com/haskell-servant/servant/issues/902)
+
 - *servant-client* Support `http-client`’s `CookieJar`
   ([#897](https://github.com/haskell-servant/servant/pull/897)
    [#883](https://github.com/haskell-servant/servant/pull/883))

servant/src/Servant/API.hs

@@ -74,7 +74,7 @@ module Servant.API (
 
 import           Servant.API.Alternative     ((:<|>) (..))
 import           Servant.API.BasicAuth       (BasicAuth,BasicAuthData(..))
-import           Servant.API.Capture         (Capture, CaptureAll)
+import           Servant.API.Capture         (Capture, Capture', CaptureAll)
 import           Servant.API.ContentTypes    (Accept (..), FormUrlEncoded,
                                               JSON,
                                               MimeRender (..), NoContent (NoContent),

servant/src/Servant/API/Capture.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE PolyKinds          #-}
 {-# OPTIONS_HADDOCK not-home    #-}
-module Servant.API.Capture (Capture, CaptureAll) where
+module Servant.API.Capture (Capture, Capture', CaptureAll) where
 
 import           Data.Typeable (Typeable)
 import           GHC.TypeLits  (Symbol)
@@ -12,9 +12,11 @@ import           GHC.TypeLits  (Symbol)
 --
 -- >>>            -- GET /books/:isbn
 -- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
-data Capture (sym :: Symbol) (a :: *)
+type Capture = Capture' '[] -- todo
-    deriving (Typeable)
 
+-- | 'Capture' which can be modified. For example with 'Description'.
+data Capture' (mods :: [*]) (sym :: Symbol) (a :: *)
+    deriving (Typeable)
 
 -- | Capture all remaining values from the request path under a certain type
 -- @a@.

servant/src/Servant/API/Description.hs

@@ -1,11 +1,25 @@
-{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE PolyKinds          #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TypeFamilies        #-}
 {-# OPTIONS_HADDOCK not-home    #-}
-module Servant.API.Description (Description, Summary) where
+module Servant.API.Description (
+    -- * Combinators
+    Description,
+    Summary,
+    -- * Used as modifiers
+    FoldDescription,
+    FoldDescription',
+    reflectDescription,
+    ) where
 
 import           Data.Typeable (Typeable)
-import           GHC.TypeLits  (Symbol)
+import           GHC.TypeLits  (Symbol, KnownSymbol, symbolVal)
+import           Data.Proxy    (Proxy (..))
+
 -- | Add a short summary for (part of) API.
 --
 -- Example:
@@ -29,6 +43,32 @@ data Summary (sym :: Symbol)
 data Description (sym :: Symbol)
     deriving (Typeable)
 
+-- | Fold modifier list to decide whether argument should be parsed strictly or leniently.
+--
+-- >>> :kind! FoldDescription '[]
+-- FoldDescription '[] :: Symbol
+-- = ""
+--
+-- >>> :kind! FoldDescription '[Required, Description "foobar", Lenient]
+-- FoldDescription '[Required, Description "foobar", Lenient] :: Symbol
+-- = "foobar"
+--
+type FoldDescription mods = FoldDescription' "" mods
+
+-- | Implementation of 'FoldDescription'.
+type family FoldDescription' (acc :: Symbol) (mods ::  [*]) :: Symbol where
+    FoldDescription' acc '[]                        = acc
+    FoldDescription' acc (Description desc ': mods) = FoldDescription' desc mods
+    FoldDescription' acc (mod     ': mods)          = FoldDescription' acc mods
+
+-- | Reflect description to the term level.
+--
+-- >>> reflectDescription (Proxy :: Proxy '[Required, Description "foobar", Lenient])
+-- "foobar"
+--
+reflectDescription :: forall mods. KnownSymbol (FoldDescription mods) => Proxy mods -> String
+reflectDescription _ = symbolVal (Proxy :: Proxy (FoldDescription mods))
+
 -- $setup
 -- >>> import Servant.API
 -- >>> import Data.Aeson

servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs

@@ -22,7 +22,7 @@ comprehensiveAPI = Proxy
 type ComprehensiveAPIWithoutRaw =
   GET :<|>
   Get '[JSON] Int :<|>
-  Capture "foo" Int :> GET :<|>
+  Capture' '[Description "example description"] "foo" Int :> GET :<|>
   Header "foo" Int :> GET :<|>
   Header' '[Required, Lenient] "bar" Int :> GET :<|>
   HttpVersion :> GET :<|>

servant/src/Servant/Utils/Links.hs

@@ -115,7 +115,7 @@ import           Prelude.Compat
 import Web.HttpApiData
 import Servant.API.Alternative ( (:<|>)((:<|>)) )
 import Servant.API.BasicAuth ( BasicAuth )
-import Servant.API.Capture ( Capture, CaptureAll )
+import Servant.API.Capture ( Capture', CaptureAll )
 import Servant.API.ReqBody ( ReqBody' )
 import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )
 import Servant.API.Header ( Header' )
@@ -336,8 +336,8 @@ instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
     toLink _ = toLink (Proxy :: Proxy sub)
 
 instance (ToHttpApiData v, HasLink sub)
-    => HasLink (Capture sym v :> sub) where
+    => HasLink (Capture' mods sym v :> sub) where
-    type MkLink (Capture sym v :> sub) = v -> MkLink sub
+    type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub
     toLink _ l v =
         toLink (Proxy :: Proxy sub) $
             addSegment (escaped . Text.unpack $ toUrlPiece v) l