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

import Polysemy.Http (Manager)
import qualified Polysemy.Http.Effect.Manager as Manager
import Polysemy.Log (Log)
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, 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 :: InterpreterFor Client r
interpretClientNet =
  (forall (rInitial :: EffectRow) x.
 Client (Sem rInitial) x -> Sem r x)
-> Sem (Client : r) a -> Sem r a
forall (e :: Effect) (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 (Manager -> BaseUrl -> ClientEnv)
-> Sem r Manager -> Sem r (BaseUrl -> ClientEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r Manager
forall (r :: EffectRow). Member Manager r => Sem r Manager
Manager.get Sem r (BaseUrl -> ClientEnv) -> Sem r BaseUrl -> Sem r ClientEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem r BaseUrl
forall (r :: EffectRow).
Members '[Reader NetConfig, Error Text] r =>
Sem r BaseUrl
localhostUrl
      (ClientError -> Text)
-> (Seq Event -> [Event])
-> Either ClientError (Seq Event)
-> Either Text [Event]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ClientError -> Text
forall b a. (Show a, IsString b) => a -> b
show Seq Event -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Either ClientError (Seq Event) -> Either Text [Event])
-> Sem r (Either ClientError (Seq Event))
-> Sem r (Either Text [Event])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError (Seq Event))
-> Sem r (Either ClientError (Seq Event))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (ClientM (Seq Event)
-> ClientEnv -> IO (Either ClientError (Seq Event))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (Seq Event)
Api.get ClientEnv
env)
    Yank event -> do
      Host
host <- Sem r Host
forall (r :: EffectRow). Member (Reader NetConfig) r => Sem r Host
localhost
      Maybe Timeout
timeout <- (NetConfig -> Maybe Timeout) -> Sem r (Maybe Timeout)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks NetConfig -> Maybe Timeout
NetConfig.timeout
      Sem (Error Text : r) () -> Sem r (Either Text ())
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Maybe Timeout -> Host -> Event -> Sem (Error Text : r) ()
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)

-- |Interpret 'Client' with a constant list of 'Event's and no capability to yank.
interpretClientConst ::
  [Event] ->
  InterpreterFor Client r
interpretClientConst :: [Event] -> InterpreterFor Client r
interpretClientConst [Event]
evs =
  (forall (rInitial :: EffectRow) x.
 Client (Sem rInitial) x -> Sem r x)
-> Sem (Client : r) a -> Sem r a
forall (e :: Effect) (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 -> Either Text [Event] -> Sem r (Either Text [Event])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Event] -> Either Text [Event]
forall a b. b -> Either a b
Right [Event]
evs)
    Yank _ -> Either Text () -> Sem r (Either Text ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"const client cannot yank")