git.iko.soy/typeable/servant
on master help sign in
Merge pull request #920 from phadej/free-client

Add Servant.Client.Free

commitfe20b5a38a632899b3d148dd871be5ef4bb6dc32 authorOleg Grenrus <oleg.grenrus@iki.fi> dateSun 11 Mar 2018, 21:07 (9 years ago) parent6d1ae0d454f533
6 files changed+37−4
compare with master
unifiedsplit
servant-client-core/servant-client-core.cabal+3 servant-client-core/src/Servant/Client/Core/Internal/ClientF.hs+10 servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs+9−2 servant-client-core/src/Servant/Client/Free.hs+15 servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs−1 servant-client/src/Servant/Client/Internal/HttpClient.hs−1
servant-client-core/servant-client-core.cabal+3
@@ -31,10 +31,12 @@ source-repository head
3131library
3232 exposed-modules:
3333 Servant.Client.Core
34+ Servant.Client.Free
3435 Servant.Client.Core.Reexport
3536 Servant.Client.Core.Internal.Auth
3637 Servant.Client.Core.Internal.BaseUrl
3738 Servant.Client.Core.Internal.BasicAuth
39+ Servant.Client.Core.Internal.ClientF
3840 Servant.Client.Core.Internal.Generic
3941 Servant.Client.Core.Internal.HasClient
4042 Servant.Client.Core.Internal.Request
@@ -65,6 +67,7 @@ library
6567 base-compat >= 0.9.3 && < 0.10
6668 , base64-bytestring >= 1.0.0.1 && < 1.1
6769 , exceptions >= 0.8.3 && < 0.9
70+ , free >= 5.0.1 && < 5.1
6871 , generics-sop >= 0.3.1.0 && < 0.4
6972 , http-api-data >= 0.3.7.1 && < 0.4
7073 , http-media >= 0.7.1.1 && < 0.8
servant-client-core/src/Servant/Client/Core/Internal/ClientF.hsnew file+10
@@ -0,0 +1,10 @@
1+{-# LANGUAGE DeriveFunctor #-}
2+module Servant.Client.Core.Internal.ClientF where
3+
4+import Servant.Client.Core.Internal.Request
5+
6+data ClientF a
7+ = RunRequest Request (Response -> a)
8+ | StreamingRequest Request (StreamingResponse -> a)
9+ | Throw ServantError
10+ deriving (Functor)
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs+9−2
@@ -10,6 +10,7 @@ import Prelude ()
1010import Prelude.Compat
1111
1212import Control.Monad (unless)
13+import Control.Monad.Free (Free (..), liftF)
1314import Data.Foldable (toList)
1415import Data.Proxy (Proxy)
1516import qualified Data.Text as T
@@ -18,16 +19,17 @@ import Network.HTTP.Media (MediaType, matches,
1819import Servant.API (MimeUnrender,
1920 contentTypes,
2021 mimeUnrender)
22+
2123import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..),
2224 StreamingResponse (..),
2325 ServantError (..))
26+import Servant.Client.Core.Internal.ClientF
2427
25−class (Monad m) => RunClient m where
28+class Monad m => RunClient m where
2629 -- | How to make a request.
2730 runRequest :: Request -> m Response
2831 streamingRequest :: Request -> m StreamingResponse
2932 throwServantError :: ServantError -> m a
30− catchServantError :: m a -> (ServantError -> m a) -> m a
3133
3234checkContentTypeHeader :: RunClient m => Response -> m MediaType
3335checkContentTypeHeader response =
@@ -48,3 +50,8 @@ decodedAs response contentType = do
4850 Right val -> return val
4951 where
5052 accept = toList $ contentTypes contentType
53+
54+instance ClientF ~ f => RunClient (Free f) where
55+ runRequest req = liftF (RunRequest req id)
56+ streamingRequest req = liftF (StreamingRequest req id)
57+ throwServantError = liftF . Throw
servant-client-core/src/Servant/Client/Free.hsnew file+15
@@ -0,0 +1,15 @@
1+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, GADTs #-}
2+module Servant.Client.Free (
3+ client,
4+ ClientF (..),
5+ module Servant.Client.Core.Reexport,
6+ ) where
7+
8+import Data.Proxy (Proxy (..))
9+import Control.Monad.Free
10+import Servant.Client.Core
11+import Servant.Client.Core.Reexport
12+import Servant.Client.Core.Internal.ClientF
13+
14+client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api
15+client api = api `clientIn` (Proxy :: Proxy (Free ClientF))
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs−1
@@ -78,7 +78,6 @@ instance Alt ClientM where
7878instance RunClient ClientM where
7979 runRequest = performRequest
8080 throwServantError = throwError
81− catchServantError = catchError
8281
8382instance ClientLike (ClientM a) (ClientM a) where
8483 mkClient = id
servant-client/src/Servant/Client/Internal/HttpClient.hs−1
@@ -96,7 +96,6 @@ instance RunClient ClientM where
9696 runRequest = performRequest
9797 streamingRequest = performStreamingRequest
9898 throwServantError = throwError
99− catchServantError = catchError
10099
101100instance ClientLike (ClientM a) (ClientM a) where
102101 mkClient = id