-- |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, 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 :: 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)
-> ([Event] -> [Event])
-> Either ClientError [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 [Event] -> [Event]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Either ClientError [Event] -> Either Text [Event])
-> Sem r (Either ClientError [Event])
-> Sem r (Either Text [Event])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError [Event])
-> Sem r (Either ClientError [Event])
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (ClientM [Event] -> ClientEnv -> IO (Either ClientError [Event])
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM [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)
    Load event -> 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
      Either Text (Maybe Event)
result <- (ClientError -> Text)
-> Either ClientError (Maybe Event) -> Either Text (Maybe Event)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ClientError -> Text
forall b a. (Show a, IsString b) => a -> b
show (Either ClientError (Maybe Event) -> Either Text (Maybe Event))
-> Sem r (Either ClientError (Maybe Event))
-> Sem r (Either Text (Maybe Event))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ClientError (Maybe Event))
-> Sem r (Either ClientError (Maybe Event))
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (ClientM (Maybe Event)
-> ClientEnv -> IO (Either ClientError (Maybe Event))
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 Either Text (Maybe Event)
-> (Maybe Event -> Either Text Event) -> Either Text Event
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Event -> Either Text Event
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 :: [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")
    Load _ -> Either Text Event -> Sem r (Either Text Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text Event
forall a b. a -> Either a b
Left Text
"const client cannot load")