eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

clean up Client and remove Setup binary

Browse source
This commit is contained in:
Brandon Martin 2015-05-08 17:51:23 -06:00
parent 7c24c2a5a3
commit bc8efb2464
4 changed files with 32 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/servant-client.cabal
View file

@ -85,4 +85,3 @@ test-suite spec
, text , text
, wai , wai
, warp , warp
, transformers

62
servant-client/src/Servant/Client.hs
View file

@ -59,10 +59,10 @@ client p baseurl = clientWithRoute p defReq baseurl
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.
class HasClient layout where class HasClient layout where
type Client' layout :: * type Client layout :: *
clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client' layout clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client layout
type Client layout = Client' layout {-type Client layout = Client layout-}
-- | A client querying function for @a ':<|>' b@ will actually hand you -- | A client querying function for @a ':<|>' b@ will actually hand you
-- one function for querying @a@ and another one for querying @b@, -- one function for querying @a@ and another one for querying @b@,
@ -78,7 +78,7 @@ type Client layout = Client' layout
-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book -- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
type Client' (a :<|> b) = Client' a :<|> Client' b type Client (a :<|> b) = Client a :<|> Client b
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy a) req baseurl :<|> clientWithRoute (Proxy :: Proxy a) req baseurl :<|>
clientWithRoute (Proxy :: Proxy b) req baseurl clientWithRoute (Proxy :: Proxy b) req baseurl
@ -105,7 +105,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
instance (KnownSymbol capture, ToText a, HasClient sublayout) instance (KnownSymbol capture, ToText a, HasClient sublayout)
=> HasClient (Capture capture a :> sublayout) where => HasClient (Capture capture a :> sublayout) where
type Client' (Capture capture a :> sublayout) = type Client (Capture capture a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req baseurl val = clientWithRoute Proxy req baseurl val =
@ -124,7 +124,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where
type Client' (Delete (ct ': cts) a) = EitherT ServantError IO a type Client (Delete (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
@ -135,7 +135,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Delete (ct ': cts) ()) where HasClient (Delete (ct ': cts) ()) where
type Client' (Delete (ct ': cts) ()) = EitherT ServantError IO () type Client (Delete (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodDelete req [204] baseurl void $ performRequestNoBody H.methodDelete req [204] baseurl
@ -147,7 +147,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Delete (ct ': cts) (Headers ls a)) where ) => HasClient (Delete (ct ': cts) (Headers ls a)) where
type Client' (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -163,7 +163,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client' (Get (ct ': cts) result) = EitherT ServantError IO result type Client (Get (ct ': cts) result) = EitherT ServantError IO result
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl
@ -174,7 +174,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Get (ct ': cts) ()) where HasClient (Get (ct ': cts) ()) where
type Client' (Get (ct ': cts) ()) = EitherT ServantError IO () type Client (Get (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
performRequestNoBody H.methodGet req [204] baseurl performRequestNoBody H.methodGet req [204] baseurl
@ -186,7 +186,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Get (ct ': cts) (Headers ls a)) where ) => HasClient (Get (ct ': cts) (Headers ls a)) where
type Client' (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -221,7 +221,7 @@ instance
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (Header sym a :> sublayout) where => HasClient (Header sym a :> sublayout) where
type Client' (Header sym a :> sublayout) = type Client (Header sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
clientWithRoute Proxy req baseurl mval = clientWithRoute Proxy req baseurl mval =
@ -243,7 +243,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client' (Post (ct ': cts) a) = EitherT ServantError IO a type Client (Post (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl
@ -254,7 +254,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Post (ct ': cts) ()) where HasClient (Post (ct ': cts) ()) where
type Client' (Post (ct ': cts) ()) = EitherT ServantError IO () type Client (Post (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPost req [204] baseurl void $ performRequestNoBody H.methodPost req [204] baseurl
@ -266,7 +266,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Post (ct ': cts) (Headers ls a)) where ) => HasClient (Post (ct ': cts) (Headers ls a)) where
type Client' (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -282,7 +282,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client' (Put (ct ': cts) a) = EitherT ServantError IO a type Client (Put (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl
@ -293,7 +293,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Put (ct ': cts) ()) where HasClient (Put (ct ': cts) ()) where
type Client' (Put (ct ': cts) ()) = EitherT ServantError IO () type Client (Put (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPut req [204] baseurl void $ performRequestNoBody H.methodPut req [204] baseurl
@ -305,7 +305,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Put (ct ': cts) (Headers ls a)) where ) => HasClient (Put (ct ': cts) (Headers ls a)) where
type Client' (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -321,7 +321,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client' (Patch (ct ': cts) a) = EitherT ServantError IO a type Client (Patch (ct ': cts) a) = EitherT ServantError IO a
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl
@ -332,7 +332,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Patch (ct ': cts) ()) where HasClient (Patch (ct ': cts) ()) where
type Client' (Patch (ct ': cts) ()) = EitherT ServantError IO () type Client (Patch (ct ': cts) ()) = EitherT ServantError IO ()
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPatch req [204] baseurl void $ performRequestNoBody H.methodPatch req [204] baseurl
@ -344,7 +344,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Patch (ct ': cts) (Headers ls a)) where ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
type Client' (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -379,7 +379,7 @@ instance
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (QueryParam sym a :> sublayout) where => HasClient (QueryParam sym a :> sublayout) where
type Client' (QueryParam sym a :> sublayout) = type Client (QueryParam sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
@ -425,7 +425,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (QueryParams sym a :> sublayout) where => HasClient (QueryParams sym a :> sublayout) where
type Client' (QueryParams sym a :> sublayout) = type Client (QueryParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req baseurl paramlist = clientWithRoute Proxy req baseurl paramlist =
@ -464,7 +464,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, HasClient sublayout) instance (KnownSymbol sym, HasClient sublayout)
=> HasClient (QueryFlag sym :> sublayout) where => HasClient (QueryFlag sym :> sublayout) where
type Client' (QueryFlag sym :> sublayout) = type Client (QueryFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req baseurl flag = clientWithRoute Proxy req baseurl flag =
@ -505,7 +505,7 @@ instance (KnownSymbol sym, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (MatrixParam sym a :> sublayout) where => HasClient (MatrixParam sym a :> sublayout) where
type Client' (MatrixParam sym a :> sublayout) = type Client (MatrixParam sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
@ -550,7 +550,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (MatrixParams sym a :> sublayout) where => HasClient (MatrixParams sym a :> sublayout) where
type Client' (MatrixParams sym a :> sublayout) = type Client (MatrixParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req baseurl paramlist = clientWithRoute Proxy req baseurl paramlist =
@ -589,7 +589,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, HasClient sublayout) instance (KnownSymbol sym, HasClient sublayout)
=> HasClient (MatrixFlag sym :> sublayout) where => HasClient (MatrixFlag sym :> sublayout) where
type Client' (MatrixFlag sym :> sublayout) = type Client (MatrixFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req baseurl flag = clientWithRoute Proxy req baseurl flag =
@ -605,9 +605,9 @@ instance (KnownSymbol sym, HasClient sublayout)
-- | Pick a 'Method' and specify where the server you want to query is. You get -- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`. -- back the full `Response`.
instance HasClient Raw where instance HasClient Raw where
type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) type Client Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client' Raw clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client Raw
clientWithRoute Proxy req baseurl httpMethod = do clientWithRoute Proxy req baseurl httpMethod = do
performRequest httpMethod req (const True) baseurl performRequest httpMethod req (const True) baseurl
@ -632,7 +632,7 @@ instance HasClient Raw where
instance (MimeRender ct a, HasClient sublayout) instance (MimeRender ct a, HasClient sublayout)
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where => HasClient (ReqBody (ct ': cts) a :> sublayout) where
type Client' (ReqBody (ct ': cts) a :> sublayout) = type Client (ReqBody (ct ': cts) a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req baseurl body = clientWithRoute Proxy req baseurl body =
@ -646,7 +646,7 @@ instance (MimeRender ct a, HasClient sublayout)
-- | Make the querying function append @path@ to the request path. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
type Client' (path :> sublayout) = Client sublayout type Client (path :> sublayout) = Client sublayout
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy sublayout)

2
servant-client/test/Servant/ClientSpec.hs
View file

@ -320,7 +320,7 @@ failSpec = withFailServer $ \ baseUrl -> do
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a, WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,
HasClient api, Client' api ~ EitherT ServantError IO ()) => HasClient api, Client api ~ EitherT ServantError IO ()) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi

BIN
servant/Setup
View file

Binary file not shown.