-- |Interpreters for 'Handlers'.
module Ribosome.Host.Interpreter.Handlers where

import qualified Data.Map.Strict as Map
import Data.MessagePack (Object)

import Ribosome.Host.Data.BootError (BootError)
import Ribosome.Host.Data.Report (Report)
import Ribosome.Host.Data.Request (RpcMethod)
import Ribosome.Host.Data.RpcError (RpcError)
import Ribosome.Host.Data.RpcHandler (
  Handler,
  RpcHandler (RpcHandler),
  RpcHandlerFun,
  hoistRpcHandlers,
  rpcHandlerMethod,
  )
import qualified Ribosome.Host.Effect.Handlers as Handlers
import Ribosome.Host.Effect.Handlers (Handlers (Register, Run))
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.RegisterHandlers (registerHandlers)

-- |Interpret 'Handlers' by performing no actions.
interpretHandlersNull :: InterpreterFor (Handlers !! Report) r
interpretHandlersNull :: forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r
interpretHandlersNull =
  (forall x (r0 :: [Effect]).
 Handlers (Sem r0) x -> Sem (Stop Report : r) x)
-> InterpreterFor (Handlers !! Report) r
forall err (eff :: Effect) (r :: [Effect]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    Handlers (Sem r0) x
Register ->
      Sem (Stop Report : r) x
forall (f :: * -> *). Applicative f => f ()
unit
    Run RpcMethod
_ [Object]
_ ->
      Maybe Object -> Sem (Stop Report : r) (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing

-- |Interpret 'Handlers' by performing no actions.
noHandlers :: InterpreterFor (Handlers !! Report) r
noHandlers :: forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r
noHandlers =
  Sem ((Handlers !! Report) : r) a -> Sem r a
forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r
interpretHandlersNull

-- |Create a method-indexed 'Map' from a set of 'RpcHandler's.
handlersByName ::
  [RpcHandler r] ->
  Map RpcMethod (RpcHandlerFun r)
handlersByName :: forall (r :: [Effect]).
[RpcHandler r] -> Map RpcMethod (RpcHandlerFun r)
handlersByName =
  [(RpcMethod, RpcHandlerFun r)] -> Map RpcMethod (RpcHandlerFun r)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RpcMethod, RpcHandlerFun r)] -> Map RpcMethod (RpcHandlerFun r))
-> ([RpcHandler r] -> [(RpcMethod, RpcHandlerFun r)])
-> [RpcHandler r]
-> Map RpcMethod (RpcHandlerFun r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RpcHandler r -> (RpcMethod, RpcHandlerFun r))
-> [RpcHandler r] -> [(RpcMethod, RpcHandlerFun r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ rpcDef :: RpcHandler r
rpcDef@(RpcHandler RpcType
_ RpcName
_ Execution
_ RpcHandlerFun r
handler) -> (RpcHandler r -> RpcMethod
forall (r :: [Effect]). RpcHandler r -> RpcMethod
rpcHandlerMethod RpcHandler r
rpcDef, RpcHandlerFun r
handler)

-- |Execute the handler corresponding to an 'RpcMethod', if it exists.
runHandler ::
  Map RpcMethod (RpcHandlerFun r) ->
  RpcMethod ->
  [Object] ->
  Handler r (Maybe Object)
runHandler :: forall (r :: [Effect]).
Map RpcMethod (RpcHandlerFun r)
-> RpcMethod -> [Object] -> Handler r (Maybe Object)
runHandler Map RpcMethod (RpcHandlerFun r)
handlers RpcMethod
method [Object]
args =
  (RpcHandlerFun r -> Sem (Stop Report : r) Object)
-> Maybe (RpcHandlerFun r) -> Sem (Stop Report : r) (Maybe Object)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (RpcHandlerFun r -> RpcHandlerFun r
forall a b. (a -> b) -> a -> b
$ [Object]
args) (RpcMethod
-> Map RpcMethod (RpcHandlerFun r) -> Maybe (RpcHandlerFun r)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RpcMethod
method Map RpcMethod (RpcHandlerFun r)
handlers)

-- |Add a set of 'RpcHandler's to the plugin.
--
-- This can be used multiple times and has to be terminated by 'interpretHandlersNull', which is done automatically when
-- using the plugin main functions.
withHandlers ::
  Members [Handlers !! Report, Rpc !! RpcError, Log, Error BootError] r =>
  [RpcHandler r] ->
  Sem r a ->
  Sem r a
withHandlers :: forall (r :: [Effect]) a.
Members
  '[Handlers !! Report, Rpc !! RpcError, Log, Error BootError] r =>
[RpcHandler r] -> Sem r a -> Sem r a
withHandlers handlersList :: [RpcHandler r]
handlersList@([RpcHandler r] -> Map RpcMethod (RpcHandlerFun r)
forall (r :: [Effect]).
[RpcHandler r] -> Map RpcMethod (RpcHandlerFun r)
handlersByName -> Map RpcMethod (RpcHandlerFun r)
handlers) =
  forall err (eff :: Effect) (r :: [Effect]) a.
(Member (Resumable err eff) r,
 FirstOrder eff "interceptResumable") =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> Sem r a -> Sem r a
interceptResumable @Report \case
    Handlers (Sem r0) x
Register -> do
      forall err (eff :: Effect) (r :: [Effect]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @Report Sem (Handlers : Stop Report : r) ()
forall (r :: [Effect]). Member Handlers r => Sem r ()
Handlers.register
      [RpcHandler r] -> Sem (Stop Report : r) ()
forall (r :: [Effect]).
Members '[Rpc !! RpcError, Log] r =>
[RpcHandler r] -> Sem (Stop Report : r) ()
registerHandlers [RpcHandler r]
handlersList
    Run RpcMethod
method [Object]
args ->
      Handler r (Maybe Object)
-> (Object -> Handler r (Maybe Object))
-> Maybe Object
-> Handler r (Maybe Object)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map RpcMethod (RpcHandlerFun r)
-> RpcMethod -> [Object] -> Handler r (Maybe Object)
forall (r :: [Effect]).
Map RpcMethod (RpcHandlerFun r)
-> RpcMethod -> [Object] -> Handler r (Maybe Object)
runHandler Map RpcMethod (RpcHandlerFun r)
handlers RpcMethod
method [Object]
args) (Maybe Object -> Handler r (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Object -> Handler r (Maybe Object))
-> (Object -> Maybe Object) -> Object -> Handler r (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Maybe Object
forall a. a -> Maybe a
Just) (Maybe Object -> Handler r (Maybe Object))
-> Handler r (Maybe Object) -> Handler r (Maybe Object)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Handlers : Stop Report : r) (Maybe Object)
-> Handler r (Maybe Object)
forall err (eff :: Effect) (r :: [Effect]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop (RpcMethod
-> [Object] -> Sem (Handlers : Stop Report : r) (Maybe Object)
forall (r :: [Effect]).
Member Handlers r =>
RpcMethod -> [Object] -> Sem r (Maybe Object)
Handlers.run RpcMethod
method [Object]
args)

-- |Interpret 'Handlers' with a set of 'RpcHandlers'.
interpretHandlers ::
  Members [Rpc !! RpcError, Log, Error BootError] r =>
  [RpcHandler r] ->
  InterpreterFor (Handlers !! Report) r
interpretHandlers :: forall (r :: [Effect]).
Members '[Rpc !! RpcError, Log, Error BootError] r =>
[RpcHandler r] -> InterpreterFor (Handlers !! Report) r
interpretHandlers [RpcHandler r]
handlers =
  Sem ((Handlers !! Report) : r) a -> Sem r a
forall (r :: [Effect]). InterpreterFor (Handlers !! Report) r
interpretHandlersNull (Sem ((Handlers !! Report) : r) a -> Sem r a)
-> (Sem ((Handlers !! Report) : r) a
    -> Sem ((Handlers !! Report) : r) a)
-> Sem ((Handlers !! Report) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [RpcHandler ((Handlers !! Report) : r)]
-> Sem ((Handlers !! Report) : r) a
-> Sem ((Handlers !! Report) : r) a
forall (r :: [Effect]) a.
Members
  '[Handlers !! Report, Rpc !! RpcError, Log, Error BootError] r =>
[RpcHandler r] -> Sem r a -> Sem r a
withHandlers ((forall x.
 Sem (Stop Report : r) x
 -> Sem (Stop Report : (Handlers !! Report) : r) x)
-> [RpcHandler r] -> [RpcHandler ((Handlers !! Report) : r)]
forall (r :: [Effect]) (r1 :: [Effect]).
(forall x. Sem (Stop Report : r) x -> Sem (Stop Report : r1) x)
-> [RpcHandler r] -> [RpcHandler r1]
hoistRpcHandlers forall x.
Sem (Stop Report : r) x
-> Sem (Stop Report : (Handlers !! Report) : r) x
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder [RpcHandler r]
handlers)