{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Polysemy.Req
(
Req (..),
req,
interpretReq,
interpretReqWith,
module Network.HTTP.Req,
)
where
import Data.Proxy
import Network.HTTP.Req hiding (MonadHttp, Req, req, req', reqBr, reqCb, runReq)
import qualified Network.HTTP.Req as R
import Polysemy
data Req m response where
Req ::
( HttpMethod method,
HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)
) =>
method ->
Url scheme ->
body ->
Proxy response ->
Option scheme ->
Req m response
makeSem ''Req
interpretReq :: Member (Embed IO) r => InterpreterFor Req r
interpretReq :: InterpreterFor Req r
interpretReq = HttpConfig -> InterpreterFor Req r
forall (r :: [Effect]).
Member (Embed IO) r =>
HttpConfig -> InterpreterFor Req r
interpretReqWith HttpConfig
defaultHttpConfig
interpretReqWith :: Member (Embed IO) r => HttpConfig -> InterpreterFor Req r
interpretReqWith :: HttpConfig -> InterpreterFor Req r
interpretReqWith HttpConfig
cfg = (forall x (rInitial :: [Effect]). Req (Sem rInitial) x -> Sem r x)
-> Sem (Req : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [Effect]). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: [Effect]). Req (Sem rInitial) x -> Sem r x)
-> Sem (Req : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
Req (Sem rInitial) x -> Sem r x)
-> Sem (Req : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
Req m u b p o -> forall (r :: [Effect]) a. Member (Embed IO) r => IO a -> Sem r a
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ HttpConfig -> Req x -> IO x
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
R.runReq HttpConfig
cfg (Req x -> IO x) -> Req x -> IO x
forall a b. (a -> b) -> a -> b
$ method -> Url scheme -> body -> Proxy x -> Option scheme -> Req x
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
R.req @R.Req method
m Url scheme
u body
b Proxy x
p Option scheme
o