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)
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")
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")