4r/nix/patches/servant-polysemy/2.patch

57 lines
1.7 KiB
Diff

From 180ea50bb0570b0cb5b6db006b4722080d71bd09 Mon Sep 17 00:00:00 2001
From: staticvoid <staticvoid@mail.i2p>
Date: Tue, 21 Jun 2022 16:15:19 +0300
Subject: [PATCH 2/2] Add generic runServantClientWith function
---
src/Servant/Polysemy/Client.hs | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/src/Servant/Polysemy/Client.hs b/src/Servant/Polysemy/Client.hs
index 1634234..d5ec3a2 100644
--- a/src/Servant/Polysemy/Client.hs
+++ b/src/Servant/Polysemy/Client.hs
@@ -39,6 +39,7 @@ module Servant.Polysemy.Client
-- * Interpreters
-- ** Non-Streaming
+ , runServantClientWith
, runServantClientUrl
, runServantClient
@@ -59,6 +60,7 @@ import Polysemy.Cont
import Polysemy.Error
import Servant.Client.Streaming
( BaseUrl
+ , ClientEnv
, ClientError
, ClientM
, mkClientEnv
@@ -79,6 +81,11 @@ runClient
=> ClientM o -> Sem r o
runClient = runClient' >=> fromEither
+runServantClientWith
+ :: Member (Embed IO) r
+ => ClientEnv -> Sem (ServantClient ': r) a -> Sem r a
+runServantClientWith env = interpret (\(RunClient' client) -> embed $ runClientM client env)
+
-- | Interpret the 'ServantClient' effect by running any calls to 'RunClient'' against the given 'BaseUrl'.
runServantClientUrl
:: Member (Embed IO) r
@@ -86,10 +93,7 @@ runServantClientUrl
runServantClientUrl server m = do
manager <- embed $ newManager tlsManagerSettings
let env = mkClientEnv manager server
- interpret (\case
- RunClient' client ->
- embed $ runClientM client env
- ) m
+ runServantClientWith env m
-- | Parse the given string as a URL and then behave as 'runServantClientUrl' does.
runServantClient
--
2.36.0