Skip to content

Commit 3e1748c

Browse files
phadejphadej
committed
Add description modifier helpers and parametrise Capture
1 parent e8e62d6 commit 3e1748c

File tree

10 files changed

+73
-27
lines changed

10 files changed

+73
-27
lines changed

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ import Servant.API ((:<|>) ((:<|>)), (:>),
3434
BuildHeadersTo (..),
3535
BuildFromStream (..),
3636
ByteStringParser (..),
37-
Capture, CaptureAll,
37+
Capture', CaptureAll,
3838
Description, EmptyAPI,
3939
FramingUnrender (..),
4040
Header', Headers (..),
@@ -155,9 +155,9 @@ instance RunClient m => HasClient m EmptyAPI where
155155
-- > getBook = client myApi
156156
-- > -- then you can just use "getBook" to query that endpoint
157157
instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
158-
=> HasClient m (Capture capture a :> api) where
158+
=> HasClient m (Capture' mods capture a :> api) where
159159

160-
type Client m (Capture capture a :> api) =
160+
type Client m (Capture' mods capture a :> api) =
161161
a -> Client m api
162162

163163
clientWithRoute pm Proxy req val =

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -795,7 +795,7 @@ instance HasDocs EmptyAPI where
795795
-- | @"books" :> 'Capture' "isbn" Text@ will appear as
796796
-- @/books/:isbn@ in the docs.
797797
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
798-
=> HasDocs (Capture sym a :> api) where
798+
=> HasDocs (Capture' mods sym a :> api) where
799799

800800
docsFor Proxy (endpoint, action) =
801801
docsFor subApiP (endpoint', action')

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -195,8 +195,8 @@ instance HasForeign lang ftype EmptyAPI where
195195
foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI
196196

197197
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
198-
=> HasForeign lang ftype (Capture sym t :> api) where
199-
type Foreign ftype (Capture sym t :> api) = Foreign ftype api
198+
=> HasForeign lang ftype (Capture' mods sym t :> api) where
199+
type Foreign ftype (Capture' mods sym t :> api) = Foreign ftype api
200200

201201
foreignFor lang Proxy Proxy req =
202202
foreignFor lang Proxy (Proxy :: Proxy api) $

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

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ import Web.HttpApiData (FromHttpApiData, parseHeader,
6767
parseQueryParam,
6868
parseUrlPieceMaybe,
6969
parseUrlPieces)
70-
import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,
70+
import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture',
7171
CaptureAll, Verb, EmptyAPI,
7272
ReflectMethod(reflectMethod),
7373
IsSecure(..), Header', QueryFlag,
@@ -164,9 +164,9 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
164164
-- > where getBook :: Text -> Handler Book
165165
-- > getBook isbn = ...
166166
instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
167-
=> HasServer (Capture capture a :> api) context where
167+
=> HasServer (Capture' mods capture a :> api) context where
168168

169-
type ServerT (Capture capture a :> api) m =
169+
type ServerT (Capture' mods capture a :> api) m =
170170
a -> ServerT api m
171171

172172
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
@@ -749,14 +749,14 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
749749
-- ...
750750
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
751751
-- ...Maybe you haven't applied enough arguments to
752-
-- ...Capture "foo"
752+
-- ...Capture' '[] "foo"
753753
-- ...
754754
--
755755
-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
756756
-- ...
757757
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
758758
-- ...Maybe you haven't applied enough arguments to
759-
-- ...Capture "foo"
759+
-- ...Capture' '[] "foo"
760760
-- ...
761761
--
762762
instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
@@ -778,7 +778,7 @@ type HasServerArrowKindError arr =
778778
-- ...
779779
-- ...No instance HasServer (a -> b).
780780
-- ...Maybe you have used '->' instead of ':>' between
781-
-- ...Capture "foo" Int
781+
-- ...Capture' '[] "foo" Int
782782
-- ...and
783783
-- ...Verb 'GET 200 '[JSON] Int
784784
-- ...
@@ -787,7 +787,7 @@ type HasServerArrowKindError arr =
787787
-- ...
788788
-- ...No instance HasServer (a -> b).
789789
-- ...Maybe you have used '->' instead of ':>' between
790-
-- ...Capture "foo" Int
790+
-- ...Capture' '[] "foo" Int
791791
-- ...and
792792
-- ...Verb 'GET 200 '[JSON] Int
793793
-- ...

‎servant/CHANGELOG.md

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,16 @@
1818
- [Querying an API - Querying Streaming APIs](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/Client.html#querying-streaming-apis)
1919

2020
- *servant* Add `Servant.API.Modifiers`
21-
([#873](https://github.com/haskell-servant/servant/pull/873))
21+
([#873](https://github.com/haskell-servant/servant/pull/873)
22+
[#903](https://github.com/haskell-servant/servant/pull/903))
2223

2324
`QueryParam`, `Header` and `ReqBody` understand modifiers:
2425
- `Required` or `Optional` (resulting in `a` or `Maybe a` in handlers)
2526
- `Strict` or `Lenient` (resulting in `a` or `Either String a` in handlers)
2627

28+
Also you can use `Description` as a modifier, but it doesn't yet work
29+
with `servant-docs`, only `servant-swagger`. [There is an issue.](https://github.com/haskell-servant/servant/issues/902)
30+
2731
- *servant-client* Support `http-client`’s `CookieJar`
2832
([#897](https://github.com/haskell-servant/servant/pull/897)
2933
[#883](https://github.com/haskell-servant/servant/pull/883))

‎servant/src/Servant/API.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ module Servant.API (
7474

7575
import Servant.API.Alternative ((:<|>) (..))
7676
import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
77-
import Servant.API.Capture (Capture, CaptureAll)
77+
import Servant.API.Capture (Capture, Capture', CaptureAll)
7878
import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
7979
JSON,
8080
MimeRender (..), NoContent (NoContent),

‎servant/src/Servant/API/Capture.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
{-# LANGUAGE DeriveDataTypeable #-}
33
{-# LANGUAGE PolyKinds #-}
44
{-# OPTIONS_HADDOCK not-home #-}
5-
module Servant.API.Capture (Capture, CaptureAll) where
5+
module Servant.API.Capture (Capture, Capture', CaptureAll) where
66

77
import Data.Typeable (Typeable)
88
import GHC.TypeLits (Symbol)
@@ -12,9 +12,11 @@ import GHC.TypeLits (Symbol)
1212
--
1313
-- >>> -- GET /books/:isbn
1414
-- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
15-
data Capture (sym :: Symbol) (a :: *)
16-
deriving (Typeable)
15+
type Capture = Capture' '[] -- todo
1716

17+
-- | 'Capture' which can be modified. For example with 'Description'.
18+
data Capture' (mods :: [*]) (sym :: Symbol) (a :: *)
19+
deriving (Typeable)
1820

1921
-- | Capture all remaining values from the request path under a certain type
2022
-- @a@.

‎servant/src/Servant/API/Description.hs

Lines changed: 45 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,25 @@
1-
{-# LANGUAGE DataKinds #-}
2-
{-# LANGUAGE DeriveDataTypeable #-}
3-
{-# LANGUAGE PolyKinds #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveDataTypeable #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE PolyKinds #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TypeOperators #-}
7+
{-# LANGUAGE TypeFamilies #-}
48
{-# OPTIONS_HADDOCK not-home #-}
5-
module Servant.API.Description (Description, Summary) where
9+
module Servant.API.Description (
10+
-- * Combinators
11+
Description,
12+
Summary,
13+
-- * Used as modifiers
14+
FoldDescription,
15+
FoldDescription',
16+
reflectDescription,
17+
) where
618

719
import Data.Typeable (Typeable)
8-
import GHC.TypeLits (Symbol)
20+
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
21+
import Data.Proxy (Proxy (..))
22+
923
-- | Add a short summary for (part of) API.
1024
--
1125
-- Example:
@@ -29,6 +43,32 @@ data Summary (sym :: Symbol)
2943
data Description (sym :: Symbol)
3044
deriving (Typeable)
3145

46+
-- | Fold modifier list to decide whether argument should be parsed strictly or leniently.
47+
--
48+
-- >>> :kind! FoldDescription '[]
49+
-- FoldDescription '[] :: Symbol
50+
-- = ""
51+
--
52+
-- >>> :kind! FoldDescription '[Required, Description "foobar", Lenient]
53+
-- FoldDescription '[Required, Description "foobar", Lenient] :: Symbol
54+
-- = "foobar"
55+
--
56+
type FoldDescription mods = FoldDescription' "" mods
57+
58+
-- | Implementation of 'FoldDescription'.
59+
type family FoldDescription' (acc :: Symbol) (mods :: [*]) :: Symbol where
60+
FoldDescription' acc '[] = acc
61+
FoldDescription' acc (Description desc ': mods) = FoldDescription' desc mods
62+
FoldDescription' acc (mod ': mods) = FoldDescription' acc mods
63+
64+
-- | Reflect description to the term level.
65+
--
66+
-- >>> reflectDescription (Proxy :: Proxy '[Required, Description "foobar", Lenient])
67+
-- "foobar"
68+
--
69+
reflectDescription :: forall mods. KnownSymbol (FoldDescription mods) => Proxy mods -> String
70+
reflectDescription _ = symbolVal (Proxy :: Proxy (FoldDescription mods))
71+
3272
-- $setup
3373
-- >>> import Servant.API
3474
-- >>> import Data.Aeson

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ comprehensiveAPI = Proxy
2222
type ComprehensiveAPIWithoutRaw =
2323
GET :<|>
2424
Get '[JSON] Int :<|>
25-
Capture "foo" Int :> GET :<|>
25+
Capture' '[Description "example description"] "foo" Int :> GET :<|>
2626
Header "foo" Int :> GET :<|>
2727
Header' '[Required, Lenient] "bar" Int :> GET :<|>
2828
HttpVersion :> GET :<|>

‎servant/src/Servant/Utils/Links.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -115,7 +115,7 @@ import Prelude.Compat
115115
import Web.HttpApiData
116116
import Servant.API.Alternative ( (:<|>)((:<|>)) )
117117
import Servant.API.BasicAuth ( BasicAuth )
118-
import Servant.API.Capture ( Capture, CaptureAll )
118+
import Servant.API.Capture ( Capture', CaptureAll )
119119
import Servant.API.ReqBody ( ReqBody' )
120120
import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )
121121
import Servant.API.Header ( Header' )
@@ -336,8 +336,8 @@ instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
336336
toLink _ = toLink (Proxy :: Proxy sub)
337337

338338
instance (ToHttpApiData v, HasLink sub)
339-
=> HasLink (Capture sym v :> sub) where
340-
type MkLink (Capture sym v :> sub) = v -> MkLink sub
339+
=> HasLink (Capture' mods sym v :> sub) where
340+
type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub
341341
toLink _ l v =
342342
toLink (Proxy :: Proxy sub) $
343343
addSegment (escaped . Text.unpack $ toUrlPiece v) l

0 commit comments

Comments
 (0)