git.iko.soy/servant
on master help sign in
Add Servant.Client.Free
commit80188e024e54b37c21bc44ee315773cde9757477 authorOleg Grenrus <oleg.grenrus@iki.fi> dateSun 11 Mar 2018, 14:03 (9 years ago) parentbcca635
4 files changed+40
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+12 servant-client-core/src/Servant/Client/Free.hs+15
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+12
@@ -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,9 +19,11 @@ 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
2528class (Monad m) => RunClient m where
2629 -- | How to make a request.
@@ -48,3 +51,12 @@ decodedAs response contentType = do
4851 Right val -> return val
4952 where
5053 accept = toList $ contentTypes contentType
54+
55+instance ClientF ~ f => RunClient (Free f) where
56+ runRequest req = liftF (RunRequest req id)
57+ streamingRequest req = liftF (StreamingRequest req id)
58+ throwServantError = liftF . Throw
59+ catchServantError x h = go x where
60+ go (Pure a) = Pure a
61+ go (Free (Throw e)) = h e
62+ go (Free f) = Free (fmap go f)
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))