{-# options_haddock prune #-}

-- |Description: Pure Http Interpreters, Internal
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 #-}

-- |In-Memory interpreter for 'Http'.
interpretHttpPure ::
  Member (Embed IO) r =>
  -- |When a request is made, one response is popped of the list and returned.
  --   If the list is exhausted, a 502 response is returned.
  [Response LByteString] ->
  -- |Chunks used for streaming responses.
  [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 #-}