-- |Client Interpreter, Internal
module Helic.Interpreter.Client where

import Polysemy.Http (Manager)
import qualified Polysemy.Http.Effect.Manager as Manager
import Servant.Client (mkClientEnv, runClientM)

import Helic.Data.Event (Event)
import qualified Helic.Data.NetConfig as NetConfig
import Helic.Data.NetConfig (NetConfig)
import Helic.Effect.Client (Client (Get, Load, Yank))
import qualified Helic.Net.Client as Api
import Helic.Net.Client (localhost, localhostUrl, sendTo)

-- |Interpret 'Client' via HTTP.
interpretClientNet ::
  Members [Manager, Reader NetConfig, Log, Error Text, Race, Embed IO] r =>
  InterpreterFor Client r
interpretClientNet :: forall (r :: EffectRow).
Members
  '[Manager, Reader NetConfig, Log, Error Text, Race, Embed IO] r =>
InterpreterFor Client r
interpretClientNet =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Client (Sem rInitial) x
Get -> do
      ClientEnv
env <- Manager -> BaseUrl -> ClientEnv
mkClientEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (r :: EffectRow).
Members '[Reader NetConfig, Error Text] r =>
Sem r BaseUrl
localhostUrl
      forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall b a. (Show a, IsString b) => a -> b
show forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM [Event]
Api.get ClientEnv
env)
    Yank Event
event -> do
      Host
host <- forall (r :: EffectRow). Member (Reader NetConfig) r => Sem r Host
localhost
      Maybe Timeout
timeout <- forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks (.timeout)
      forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (forall (r :: EffectRow).
Members '[Manager, Log, Race, Error Text, Embed IO] r =>
Maybe Timeout -> Host -> Event -> Sem r ()
sendTo Maybe Timeout
timeout Host
host Event
event)
    Load Int
event -> do
      ClientEnv
env <- Manager -> BaseUrl -> ClientEnv
mkClientEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (r :: EffectRow).
Members '[Reader NetConfig, Error Text] r =>
Sem r BaseUrl
localhostUrl
      Either Text (Maybe Event)
result <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall b a. (Show a, IsString b) => a -> b
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Int -> ClientM (Maybe Event)
Api.load Int
event) ClientEnv
env)
      pure (Either Text (Maybe Event)
result forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall l r. l -> Maybe r -> Either l r
maybeToRight Text
"There is no event for that index")

-- |Interpret 'Client' with a constant list of 'Event's and no capability to yank.
interpretClientConst ::
  [Event] ->
  InterpreterFor Client r
interpretClientConst :: forall (r :: EffectRow). [Event] -> InterpreterFor Client r
interpretClientConst [Event]
evs =
  forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Client (Sem rInitial) x
Get -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right [Event]
evs)
    Yank Event
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Text
"const client cannot yank")
    Load Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Text
"const client cannot load")