summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormrkkrp <>2020-10-17 15:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-17 15:45:00 (GMT)
commit08da0b13a80f595e7263ee02619281222541ff2b (patch)
tree6e3a7373b868d86ea7f18744b378b4536b3a3936
parent9607d61c36e00dd3707c65fbe9ecda19daff37a4 (diff)
version 3.7.03.7.0
-rw-r--r--CHANGELOG.md7
-rw-r--r--Network/HTTP/Req.hs73
-rw-r--r--req.cabal6
3 files changed, 75 insertions, 11 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index f2230ce..c139559 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,10 @@
+## Req 3.7.0
+
+* Added `reqCb`, a function that allows you to modify the `Request` object
+ but otherwise performs the requst for you.
+
+* Derived `MonadThrow`, `MonadCatch`, and `MonadMask` for the `Req` monad.
+
## Req 3.6.0
* Added the `httpConfigBodyPreviewLength` configuration parameter to
diff --git a/Network/HTTP/Req.hs b/Network/HTTP/Req.hs
index 1aa4f65..46e9b28 100644
--- a/Network/HTTP/Req.hs
+++ b/Network/HTTP/Req.hs
@@ -14,6 +14,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
@@ -112,6 +113,7 @@ module Network.HTTP.Req
-- $making-a-request
req,
reqBr,
+ reqCb,
req',
withReqManager,
@@ -235,7 +237,7 @@ import Control.Applicative
import Control.Arrow (first, second)
import Control.Exception hiding (Handler (..), TypeError)
import Control.Monad.Base
-import Control.Monad.Catch (Handler (..))
+import Control.Monad.Catch (Handler (..), MonadCatch, MonadMask, MonadThrow)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Reader
@@ -429,12 +431,7 @@ req ::
-- | Response
m response
req method url body responseProxy options =
- reqBr method url body (options <> extraOptions) getHttpResponse
- where
- extraOptions =
- case acceptHeader responseProxy of
- Nothing -> mempty
- Just accept -> header "Accept" accept
+ reqCb method url body responseProxy options pure
-- | A version of 'req' that does not use one of the predefined instances of
-- 'HttpResponse' but instead allows the user to consume @'L.Response'
@@ -459,7 +456,58 @@ reqBr ::
(L.Response L.BodyReader -> IO a) ->
-- | Result
m a
-reqBr method url body options consume = req' method url body options $ \request manager -> do
+reqBr method url body options consume =
+ req' method url body options (reqHandler consume)
+
+-- | A version of 'req' that takes a callback to modify the 'L.Request', but
+-- otherwise performs the request identically.
+--
+-- @since 3.7.0
+reqCb ::
+ ( MonadHttp m,
+ HttpMethod method,
+ HttpBody body,
+ HttpResponse response,
+ HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
+ ) =>
+ -- | HTTP method
+ method ->
+ -- | 'Url'—location of resource
+ Url scheme ->
+ -- | Body of the request
+ body ->
+ -- | A hint how to interpret response
+ Proxy response ->
+ -- | Collection of optional parameters
+ Option scheme ->
+ -- | Callback to modify the request
+ (L.Request -> m L.Request) ->
+ -- | Response
+ m response
+reqCb method url body responseProxy options adjustRequest =
+ req' method url body (options <> extraOptions) $ \request manager -> do
+ request' <- adjustRequest request
+ reqHandler getHttpResponse request' manager
+ where
+ extraOptions =
+ case acceptHeader responseProxy of
+ Nothing -> mempty
+ Just accept -> header "Accept" accept
+
+-- | The default handler function that the higher-level request functions
+-- pass to 'req''. Internal function.
+--
+-- @since 3.7.0
+reqHandler ::
+ MonadHttp m =>
+ -- | How to get final result from a 'L.Response'
+ (L.Response L.BodyReader -> IO b) ->
+ -- | 'L.Request' to perform
+ L.Request ->
+ -- | 'L.Manager' to use
+ L.Manager ->
+ m b
+reqHandler consume request manager = do
HttpConfig {..} <- getHttpConfig
let wrapVanilla = handle (throwIO . VanillaHttpException)
wrapExc = handle (throwIO . LI.toHttpException request)
@@ -729,6 +777,15 @@ newtype Req a = Req (ReaderT HttpConfig IO a)
MonadUnliftIO
)
+-- | @since 3.7.0
+deriving instance MonadThrow Req
+
+-- | @since 3.7.0
+deriving instance MonadCatch Req
+
+-- | @since 3.7.0
+deriving instance MonadMask Req
+
instance MonadBase IO Req where
liftBase = liftIO
diff --git a/req.cabal b/req.cabal
index 9514c75..5590a69 100644
--- a/req.cabal
+++ b/req.cabal
@@ -1,11 +1,11 @@
cabal-version: 1.18
name: req
-version: 3.6.0
+version: 3.7.0
license: BSD3
license-file: LICENSE.md
maintainer: Mark Karpov <markkarpov92@gmail.com>
author: Mark Karpov <markkarpov92@gmail.com>
-tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.1
+tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.2
homepage: https://github.com/mrkkrp/req
bug-reports: https://github.com/mrkkrp/req/issues
synopsis:
@@ -122,7 +122,7 @@ test-suite httpbin-tests
mtl >=2.0 && <3.0,
req -any,
text >=0.2 && <1.3,
- unordered-containers >=0.2.5 && <0.2.13
+ unordered-containers >=0.2.5 && <0.3
if flag(dev)
ghc-options: -O0 -Wall -Werror