3e1748c · servant · git.iko.soy

git.iko.soy/servant

Add description modifier helpers and parametrise Capture

commit3e1748c96583598681f78bea068032ef46ad40b0 authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 9 Feb 2018, 12:05 (9 years ago) parente8e62d6

10 files changed+73−27

compare with master

unifiedsplit

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+3−3 servant-docs/src/Servant/Docs/Internal.hs+1−1 servant-foreign/src/Servant/Foreign/Internal.hs+2−2 servant-server/src/Servant/Server/Internal.hs+7−7 servant/CHANGELOG.md+5−1 servant/src/Servant/API.hs+1−1 servant/src/Servant/API/Capture.hs+5−3 servant/src/Servant/API/Description.hs+45−5 servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+1−1 servant/src/Servant/Utils/Links.hs+3−3

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

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

157157instance (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+1−1

@@ -795,7 +795,7 @@ instance HasDocs EmptyAPI where

795795-- | @"books" :> 'Capture' "isbn" Text@ will appear as

796796-- @/books/:isbn@ in the docs.

797797instance (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+2−2

@@ -195,8 +195,8 @@ instance HasForeign lang ftype EmptyAPI where

195195 foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI

196196

197197instance (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+7−7

@@ -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 = ...

166166instance (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--

762762instance 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+5−1

@@ -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+1−1

@@ -74,7 +74,7 @@ module Servant.API (

7474

7575import Servant.API.Alternative ((:<|>) (..))

7676import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))

77−import Servant.API.Capture (Capture, CaptureAll)

77+import Servant.API.Capture (Capture, Capture', CaptureAll)

7878import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

7979 JSON,

8080 MimeRender (..), NoContent (NoContent),

servant/src/Servant/API/Capture.hs+5−3

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

77import Data.Typeable (Typeable)

88import 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+45−5

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

719import 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)

2943data 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+1−1

@@ -22,7 +22,7 @@ comprehensiveAPI = Proxy

2222type 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+3−3

@@ -115,7 +115,7 @@ import Prelude.Compat

115115import Web.HttpApiData

116116import Servant.API.Alternative ( (:<|>)((:<|>)) )

117117import Servant.API.BasicAuth ( BasicAuth )

118−import Servant.API.Capture ( Capture, CaptureAll )

118+import Servant.API.Capture ( Capture', CaptureAll )

119119import Servant.API.ReqBody ( ReqBody' )

120120import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )

121121import 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

338338instance (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