From 7b852250346c1bf63d469a3e3f7fd600d05bbdbc Mon Sep 17 00:00:00 2001 From: Dmitry Olshansky Date: Wed, 3 Aug 2022 14:32:11 +0200 Subject: [PATCH] Add Bifunctor instance --- src/Servant/Common/Req.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs index 8cda4ad..f74ead2 100644 --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -16,7 +16,7 @@ import Control.Arrow ((&&&)) import Control.Concurrent import Control.Monad (join) import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Bifunctor (first) +import Data.Bifunctor (Bifunctor(..)) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy.Char8 as BL import Data.ByteString (ByteString) @@ -52,6 +52,13 @@ data ReqResult tag a -- ^ A failure to construct the request tagged with 'tag' at trigger time deriving (Functor) +instance Bifunctor ReqResult where + first f = \case + ResponseSuccess tag a r -> ResponseSuccess (f tag) a r + ResponseFailure tag t r -> ResponseFailure (f tag) t r + RequestFailure tag t -> RequestFailure (f tag) t + second = fmap + data ClientOptions = ClientOptions { optsRequestFixup :: forall a. Show a => XhrRequest a -> JSM (XhrRequest a) -- ^ Aribtrarily modify requests just before they are sent.