-- |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 = interpretResumable \case Register -> unit Run _ _ -> pure Nothing -- |Interpret 'Handlers' by performing no actions. noHandlers :: InterpreterFor (Handlers !! Report) r noHandlers = interpretHandlersNull -- |Create a method-indexed 'Map' from a set of 'RpcHandler's. handlersByName :: [RpcHandler r] -> Map RpcMethod (RpcHandlerFun r) handlersByName = Map.fromList . fmap \ rpcDef@(RpcHandler _ _ _ handler) -> (rpcHandlerMethod rpcDef, handler) -- |Execute the handler corresponding to an 'RpcMethod', if it exists. runHandler :: Map RpcMethod (RpcHandlerFun r) -> RpcMethod -> [Object] -> Handler r (Maybe Object) runHandler handlers method args = traverse ($ args) (Map.lookup method 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 handlersList@(handlersByName -> handlers) = interceptResumable @Report \case Register -> do restop @Report Handlers.register registerHandlers handlersList Run method args -> maybe (runHandler handlers method args) (pure . Just) =<< restop (Handlers.run method args) -- |Interpret 'Handlers' with a set of 'RpcHandlers'. interpretHandlers :: Members [Rpc !! RpcError, Log, Error BootError] r => [RpcHandler r] -> InterpreterFor (Handlers !! Report) r interpretHandlers handlers = interpretHandlersNull . withHandlers (hoistRpcHandlers raiseUnder handlers)