{-# options_haddock prune #-}
module Polysemy.Http.Interpreter.Pure where
import Network.HTTP.Client.Internal (CookieJar (CJ))
import Polysemy.Internal.Tactics (liftT)
import Polysemy.Http.Data.Response (Response (Response))
import qualified Polysemy.Http.Effect.Http as Http
import Polysemy.Http.Effect.Http (Http)
takeResponse ::
Member (State [Response LByteString]) r =>
[Response LByteString] ->
Sem r (Response LByteString)
takeResponse :: forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse (Response LByteString
response : [Response LByteString]
rest) =
Response LByteString
response forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put [Response LByteString]
rest
takeResponse [] =
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b. Status -> b -> [Header] -> CookieJar -> Response b
Response (forall a. Enum a => Int -> a
toEnum Int
502) LByteString
"test responses exhausted" [] ([Cookie] -> CookieJar
CJ forall a. Monoid a => a
mempty))
takeChunk ::
Member (State [ByteString]) r =>
[ByteString] ->
Sem r ByteString
takeChunk :: forall (r :: EffectRow).
Member (State [ByteString]) r =>
[ByteString] -> Sem r ByteString
takeChunk (ByteString
chunk : [ByteString]
rest) =
ByteString
chunk forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put [ByteString]
rest
takeChunk [] =
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
interpretHttpPureWithState ::
Members [State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState :: forall (r :: EffectRow).
Members
'[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState =
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
Http.Response Request
_ Response LByteString -> Sem rInitial a1
f -> do
f (Response LByteString)
res <- forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
(e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise forall s (r :: EffectRow). Member (State s) r => Sem r s
get
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
(e :: (* -> *) -> * -> *) a b.
(a -> m b) -> f a -> Sem (WithTactics e f m r) (f b)
bindTSimple Response LByteString -> Sem rInitial a1
f f (Response LByteString)
res
Http.Request Request
_ ->
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
(e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Member (State [Response LByteString]) r =>
[Response LByteString] -> Sem r (Response LByteString)
takeResponse forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise forall s (r :: EffectRow). Member (State s) r => Sem r s
get
Http.ConsumeChunk Maybe Int
_ LByteString
_ ->
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
(e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Member (State [ByteString]) r =>
[ByteString] -> Sem r ByteString
takeChunk forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise forall s (r :: EffectRow). Member (State s) r => Sem r s
get
{-# inline interpretHttpPureWithState #-}
interpretHttpPure ::
Member (Embed IO) r =>
[Response LByteString] ->
[ByteString] ->
InterpretersFor [Http LByteString, State [Response LByteString], State [ByteString]] r
interpretHttpPure :: forall (r :: EffectRow).
Member (Embed IO) r =>
[Response LByteString]
-> [ByteString]
-> InterpretersFor
'[Http LByteString, State [Response LByteString],
State [ByteString]]
r
interpretHttpPure [Response LByteString]
responses [ByteString]
chunks =
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState [ByteString]
chunks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
evalState [Response LByteString]
responses forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Members
'[State [ByteString], State [Response LByteString], Embed IO] r =>
InterpreterFor (Http LByteString) r
interpretHttpPureWithState
{-# inline interpretHttpPure #-}