0173087 · servant · git.iko.soy

git.iko.soy/servant

Merge pull request #25 from haskell-servant/canonical-types-rebased

Canonical types rebased

commit01730871665a48f260348dc9807efbcb7cd45a22 authorAlp Mestanogullari <alpmestan@gmail.com> dateMon 20 Apr 2015, 09:37 (11 years ago) parent14f6352 d7fcf2b

4 files changed+79−74

compare with master

unifiedsplit

CHANGELOG.md+1 src/Servant/Client.hs+41−37 src/Servant/Common/Req.hs+1−1 test/Servant/ClientSpec.hs+36−36

CHANGELOG.md+1

@@ -7,6 +7,7 @@

77* Make the clients for `Raw` endpoints return the whole `Response` value (to be able to access response headers for example)

88* Support for PATCH

99* Make () instances expect No Content status code, and not try to decode body.

10+* `Canonicalize` API types before generating client functions for them

1011

11120.2.2

1213-----

src/Servant/Client.hs+41−37

@@ -2,6 +2,7 @@

22{-# LANGUAGE InstanceSigs #-}

33{-# LANGUAGE TypeFamilies #-}

44{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE FlexibleContexts #-}

56{-# LANGUAGE FlexibleInstances #-}

67{-# LANGUAGE OverloadedStrings #-}

78{-# LANGUAGE OverlappingInstances #-}

@@ -12,6 +13,7 @@

1213module Servant.Client

1314 ( client

1415 , HasClient(..)

16+ , Client

1517 , ServantError(..)

1618 , module Servant.Common.BaseUrl

1719 ) where

@@ -45,15 +47,17 @@ import Servant.Common.Req

4547-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]

4648-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book

4749-- > (getAllBooks :<|> postNewBook) = client myApi

48−client :: HasClient layout => Proxy layout -> Client layout

49−client p = clientWithRoute p defReq

50+client :: HasClient (Canonicalize layout) => Proxy layout -> Client layout

51+client p = clientWithRoute (canonicalize p) defReq

5052

5153-- | This class lets us define how each API combinator

5254-- influences the creation of an HTTP request. It's mostly

5355-- an internal class, you can just use 'client'.

5456class HasClient layout where

55− type Client layout :: *

56− clientWithRoute :: Proxy layout -> Req -> Client layout

57+ type Client' layout :: *

58+ clientWithRoute :: Proxy layout -> Req -> Client' layout

59+

60+type Client layout = Client' (Canonicalize layout)

5761

5862-- | A client querying function for @a ':<|>' b@ will actually hand you

5963-- one function for querying @a@ and another one for querying @b@,

@@ -69,7 +73,7 @@ class HasClient layout where

6973-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book

7074-- > (getAllBooks :<|> postNewBook) = client myApi

7175instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

72− type Client (a :<|> b) = Client a :<|> Client b

76+ type Client' (a :<|> b) = Client' a :<|> Client' b

7377 clientWithRoute Proxy req =

7478 clientWithRoute (Proxy :: Proxy a) req :<|>

7579 clientWithRoute (Proxy :: Proxy b) req

@@ -96,8 +100,8 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where

96100instance (KnownSymbol capture, ToText a, HasClient sublayout)

97101 => HasClient (Capture capture a :> sublayout) where

98102

99− type Client (Capture capture a :> sublayout) =

100− a -> Client sublayout

103+ type Client' (Capture capture a :> sublayout) =

104+ a -> Client' sublayout

101105

102106 clientWithRoute Proxy req val =

103107 clientWithRoute (Proxy :: Proxy sublayout) $

@@ -110,7 +114,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)

110114-- will just require an argument that specifies the scheme, host

111115-- and port to send the request to.

112116instance HasClient Delete where

113− type Client Delete = BaseUrl -> EitherT ServantError IO ()

117+ type Client' Delete = BaseUrl -> EitherT ServantError IO ()

114118

115119 clientWithRoute Proxy req host =

116120 void $ performRequest H.methodDelete req (`elem` [200, 202, 204]) host

@@ -120,14 +124,14 @@ instance HasClient Delete where

120124-- will just require an argument that specifies the scheme, host

121125-- and port to send the request to.

122126instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where

123− type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result

127+ type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result

124128 clientWithRoute Proxy req host =

125129 performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host

126130

127131-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content

128132-- HTTP header.

129133instance HasClient (Get (ct ': cts) ()) where

130− type Client (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

134+ type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

131135 clientWithRoute Proxy req host =

132136 performRequestNoBody H.methodGet req [204] host

133137

@@ -159,12 +163,12 @@ instance HasClient (Get (ct ': cts) ()) where

159163instance (KnownSymbol sym, ToText a, HasClient sublayout)

160164 => HasClient (Header sym a :> sublayout) where

161165

162− type Client (Header sym a :> sublayout) =

163− Maybe a -> Client sublayout

166+ type Client' (Header sym a :> sublayout) =

167+ Maybe a -> Client' sublayout

164168

165169 clientWithRoute Proxy req mval =

166170 clientWithRoute (Proxy :: Proxy sublayout) $

167− maybe req (\value -> addHeader hname value req) mval

171+ maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval

168172

169173 where hname = symbolVal (Proxy :: Proxy sym)

170174

@@ -173,7 +177,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

173177-- will just require an argument that specifies the scheme, host

174178-- and port to send the request to.

175179instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

176− type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

180+ type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

177181

178182 clientWithRoute Proxy req uri =

179183 performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri

@@ -181,7 +185,7 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where

181185-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content

182186-- HTTP header.

183187instance HasClient (Post (ct ': cts) ()) where

184− type Client (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

188+ type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

185189 clientWithRoute Proxy req host =

186190 void $ performRequestNoBody H.methodPost req [204] host

187191

@@ -190,7 +194,7 @@ instance HasClient (Post (ct ': cts) ()) where

190194-- will just require an argument that specifies the scheme, host

191195-- and port to send the request to.

192196instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

193− type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

197+ type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

194198

195199 clientWithRoute Proxy req host =

196200 performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host

@@ -198,7 +202,7 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where

198202-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content

199203-- HTTP header.

200204instance HasClient (Put (ct ': cts) ()) where

201− type Client (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

205+ type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

202206 clientWithRoute Proxy req host =

203207 void $ performRequestNoBody H.methodPut req [204] host

204208

@@ -207,7 +211,7 @@ instance HasClient (Put (ct ': cts) ()) where

207211-- will just require an argument that specifies the scheme, host

208212-- and port to send the request to.

209213instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

210− type Client (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

214+ type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a

211215

212216 clientWithRoute Proxy req host =

213217 performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host

@@ -215,7 +219,7 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where

215219-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content

216220-- HTTP header.

217221instance HasClient (Patch (ct ': cts) ()) where

218− type Client (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

222+ type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()

219223 clientWithRoute Proxy req host =

220224 void $ performRequestNoBody H.methodPatch req [204] host

221225

@@ -247,8 +251,8 @@ instance HasClient (Patch (ct ': cts) ()) where

247251instance (KnownSymbol sym, ToText a, HasClient sublayout)

248252 => HasClient (QueryParam sym a :> sublayout) where

249253

250− type Client (QueryParam sym a :> sublayout) =

251− Maybe a -> Client sublayout

254+ type Client' (QueryParam sym a :> sublayout) =

255+ Maybe a -> Client' sublayout

252256

253257 -- if mparam = Nothing, we don't add it to the query string

254258 clientWithRoute Proxy req mparam =

@@ -289,8 +293,8 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

289293instance (KnownSymbol sym, ToText a, HasClient sublayout)

290294 => HasClient (QueryParams sym a :> sublayout) where

291295

292− type Client (QueryParams sym a :> sublayout) =

293− [a] -> Client sublayout

296+ type Client' (QueryParams sym a :> sublayout) =

297+ [a] -> Client' sublayout

294298

295299 clientWithRoute Proxy req paramlist =

296300 clientWithRoute (Proxy :: Proxy sublayout) $

@@ -324,8 +328,8 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

324328instance (KnownSymbol sym, HasClient sublayout)

325329 => HasClient (QueryFlag sym :> sublayout) where

326330

327− type Client (QueryFlag sym :> sublayout) =

328− Bool -> Client sublayout

331+ type Client' (QueryFlag sym :> sublayout) =

332+ Bool -> Client' sublayout

329333

330334 clientWithRoute Proxy req flag =

331335 clientWithRoute (Proxy :: Proxy sublayout) $

@@ -363,8 +367,8 @@ instance (KnownSymbol sym, HasClient sublayout)

363367instance (KnownSymbol sym, ToText a, HasClient sublayout)

364368 => HasClient (MatrixParam sym a :> sublayout) where

365369

366− type Client (MatrixParam sym a :> sublayout) =

367− Maybe a -> Client sublayout

370+ type Client' (MatrixParam sym a :> sublayout) =

371+ Maybe a -> Client' sublayout

368372

369373 -- if mparam = Nothing, we don't add it to the query string

370374 clientWithRoute Proxy req mparam =

@@ -404,8 +408,8 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

404408instance (KnownSymbol sym, ToText a, HasClient sublayout)

405409 => HasClient (MatrixParams sym a :> sublayout) where

406410

407− type Client (MatrixParams sym a :> sublayout) =

408− [a] -> Client sublayout

411+ type Client' (MatrixParams sym a :> sublayout) =

412+ [a] -> Client' sublayout

409413

410414 clientWithRoute Proxy req paramlist =

411415 clientWithRoute (Proxy :: Proxy sublayout) $

@@ -439,8 +443,8 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)

439443instance (KnownSymbol sym, HasClient sublayout)

440444 => HasClient (MatrixFlag sym :> sublayout) where

441445

442− type Client (MatrixFlag sym :> sublayout) =

443− Bool -> Client sublayout

446+ type Client' (MatrixFlag sym :> sublayout) =

447+ Bool -> Client' sublayout

444448

445449 clientWithRoute Proxy req flag =

446450 clientWithRoute (Proxy :: Proxy sublayout) $

@@ -453,9 +457,9 @@ instance (KnownSymbol sym, HasClient sublayout)

453457-- | Pick a 'Method' and specify where the server you want to query is. You get

454458-- back the full `Response`.

455459instance HasClient Raw where

456− type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)

460+ type Client' Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)

457461

458− clientWithRoute :: Proxy Raw -> Req -> Client Raw

462+ clientWithRoute :: Proxy Raw -> Req -> Client' Raw

459463 clientWithRoute Proxy req httpMethod host = do

460464 performRequest httpMethod req (const True) host

461465

@@ -480,17 +484,17 @@ instance HasClient Raw where

480484instance (MimeRender ct a, HasClient sublayout)

481485 => HasClient (ReqBody (ct ': cts) a :> sublayout) where

482486

483− type Client (ReqBody (ct ': cts) a :> sublayout) =

484− a -> Client sublayout

487+ type Client' (ReqBody (ct ': cts) a :> sublayout) =

488+ a -> Client' sublayout

485489

486490 clientWithRoute Proxy req body =

487491 clientWithRoute (Proxy :: Proxy sublayout) $ do

488492 let ctProxy = Proxy :: Proxy ct

489− setRQBody (toByteString ctProxy body) (contentType ctProxy) req

493+ setRQBody (mimeRender ctProxy body) (contentType ctProxy) req

490494

491495-- | Make the querying function append @path@ to the request path.

492496instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

493− type Client (path :> sublayout) = Client sublayout

497+ type Client' (path :> sublayout) = Client' sublayout

494498

495499 clientWithRoute Proxy req =

496500 clientWithRoute (Proxy :: Proxy sublayout) $

src/Servant/Common/Req.hs+1−1

@@ -172,7 +172,7 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do

172172 either

173173 (left . (\s -> DecodeFailure s respCT respBody))

174174 return

175− (fromByteString ct respBody)

175+ (mimeUnrender ct respBody)

176176

177177performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()

178178performRequestNoBody reqMethod req wantedStatus reqHost = do

test/Servant/ClientSpec.hs+36−36

@@ -1,42 +1,42 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE ViewPatterns #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE TypeOperators #-}

6−{-# LANGUAGE RecordWildCards #-}

7−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE GADTs #-}

5+{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE RecordWildCards #-}

87{-# LANGUAGE StandaloneDeriving #-}

8+{-# LANGUAGE TypeOperators #-}

99{-# OPTIONS_GHC -fcontext-stack=25 #-}

1010{-# OPTIONS_GHC -fno-warn-orphans #-}

1111module Servant.ClientSpec where

1212

13−import Control.Applicative

14−import qualified Control.Arrow as Arrow

15−import Control.Concurrent

16−import Control.Exception

17−import Control.Monad.Trans.Either

18−import Data.Aeson

19−import Data.ByteString.Lazy (ByteString)

20−import Data.Char

21−import Data.Foldable (forM_)

22−import Data.Monoid

23−import Data.Proxy

24−import qualified Data.Text as T

25−import GHC.Generics

26−import qualified Network.HTTP.Client as C

27−import Network.HTTP.Media

28−import Network.HTTP.Types

29−import Network.Socket

30−import Network.Wai hiding (Response)

31−import Network.Wai.Handler.Warp

32−import Test.Hspec

33−import Test.Hspec.QuickCheck

34−import Test.HUnit

35−import Test.QuickCheck

36−

37−import Servant.API

38−import Servant.Client

39−import Servant.Server

13+import Control.Applicative

14+import qualified Control.Arrow as Arrow

15+import Control.Concurrent

16+import Control.Exception

17+import Control.Monad.Trans.Either

18+import Data.Aeson

19+import Data.ByteString.Lazy (ByteString)

20+import Data.Char

21+import Data.Foldable (forM_)

22+import Data.Monoid

23+import Data.Proxy

24+import qualified Data.Text as T

25+import GHC.Generics

26+import qualified Network.HTTP.Client as C

27+import Network.HTTP.Media

28+import Network.HTTP.Types

29+import Network.Socket

30+import Network.Wai hiding (Response)

31+import Network.Wai.Handler.Warp

32+import Test.Hspec

33+import Test.Hspec.QuickCheck

34+import Test.HUnit

35+import Test.QuickCheck

36+

37+import Servant.API

38+import Servant.Client

39+import Servant.Server

4040

4141-- * test data types

4242

@@ -289,8 +289,8 @@ spec = do

289289 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

290290

291291data WrappedApi where

292− WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,

293− HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>

292+ WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT (Int, String) IO a,

293+ HasClient (Canonicalize api), Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>

294294 Proxy api -> WrappedApi

295295

296296