module Ribosome.Host.RegisterHandlers where import qualified Data.Text as Text import Exon (exon) import qualified Polysemy.Log as Log import Ribosome.Host.Api.Autocmd (autocmd) import Ribosome.Host.Api.Data (nvimCommand, nvimCreateUserCommand) import Ribosome.Host.Class.Msgpack.Encode (toMsgpack) import Ribosome.Host.Data.ChannelId (ChannelId (ChannelId)) import Ribosome.Host.Data.Execution (Execution (Async, Sync)) import Ribosome.Host.Data.Report (Report, resumeReport) import Ribosome.Host.Data.Request (RpcMethod (RpcMethod)) import Ribosome.Host.Data.RpcCall (RpcCall) import Ribosome.Host.Data.RpcError (RpcError, rpcError) import Ribosome.Host.Data.RpcHandler (RpcHandler (RpcHandler), rpcMethod) import Ribosome.Host.Data.RpcName (RpcName (RpcName)) import qualified Ribosome.Host.Data.RpcType as RpcType import Ribosome.Host.Data.RpcType (CommandArgs (CommandArgs), CommandOptions (CommandOptions), RpcType, completionValue) import qualified Ribosome.Host.Effect.Rpc as Rpc import Ribosome.Host.Effect.Rpc (Rpc) registerFailed :: Member Log r => RpcError -> Sem r () registerFailed :: forall (r :: EffectRow). Member Log r => RpcError -> Sem r () registerFailed RpcError e = Text -> Sem r () forall (r :: EffectRow). (HasCallStack, Member Log r) => Text -> Sem r () Log.error [exon|Registering rpc handlers failed: #{rpcError e}|] trigger :: Execution -> Text trigger :: Execution -> Text trigger = \case Execution Sync -> Text "rpcrequest" Execution Async -> Text "rpcnotify" rpcCall :: ChannelId -> RpcMethod -> Execution -> Maybe Text -> Text rpcCall :: ChannelId -> RpcMethod -> Execution -> Maybe Text -> Text rpcCall (ChannelId Int64 i) (RpcMethod Text method) Execution exec Maybe Text args = [exon|call('#{trigger exec}', [#{show i}, '#{method}']#{foldMap appendArgs args})|] where appendArgs :: a -> a appendArgs a a = [exon| + #{a}|] registerType :: ChannelId -> RpcMethod -> RpcName -> Execution -> RpcType -> RpcCall () registerType :: ChannelId -> RpcMethod -> RpcName -> Execution -> RpcType -> RpcCall () registerType ChannelId i RpcMethod method (RpcName Text name) Execution exec = \case RpcType RpcType.Function -> Text -> RpcCall () nvimCommand [exon|function! #{name}(...) range return #{rpcCall i method exec (Just "a:000")} endfunction|] RpcType.Command (CommandOptions Map Text Object options Maybe CommandCompletion comp) (CommandArgs [Text] args) -> Text -> Text -> Map Text Object -> RpcCall () forall p_1. MsgpackEncode p_1 => Text -> p_1 -> Map Text Object -> RpcCall () nvimCreateUserCommand Text name [exon|call #{rpcCall i method exec (Just argsText)}|] (Map Text Object options Map Text Object -> Map Text Object -> Map Text Object forall a. Semigroup a => a -> a -> a <> (CommandCompletion -> Map Text Object) -> Maybe CommandCompletion -> Map Text Object forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap CommandCompletion -> Map Text Object forall {l} {a}. (IsList l, IsString a, Item l ~ (a, Object)) => CommandCompletion -> l compOpt Maybe CommandCompletion comp) where compOpt :: CommandCompletion -> l compOpt CommandCompletion c = [(a "complete", Text -> Object forall a. MsgpackEncode a => a -> Object toMsgpack (CommandCompletion -> Text completionValue CommandCompletion c))] argsText :: Text argsText = [exon|[#{Text.intercalate ", " args}]|] RpcType.Autocmd AutocmdEvents events AutocmdOptions options -> RpcCall AutocmdId -> RpcCall () forall (f :: * -> *) a. Functor f => f a -> f () void (AutocmdEvents -> AutocmdOptions -> Text -> RpcCall AutocmdId autocmd AutocmdEvents events AutocmdOptions options [exon|call #{rpcCall i method exec Nothing}|]) registerHandler :: ChannelId -> RpcHandler r -> RpcCall () registerHandler :: forall (r :: EffectRow). ChannelId -> RpcHandler r -> RpcCall () registerHandler ChannelId i (RpcHandler RpcType tpe RpcName name Execution exec RpcHandlerFun r _) = ChannelId -> RpcMethod -> RpcName -> Execution -> RpcType -> RpcCall () registerType ChannelId i (RpcType -> RpcName -> RpcMethod rpcMethod RpcType tpe RpcName name) RpcName name Execution exec RpcType tpe registerHandlers :: Members [Rpc !! RpcError, Log] r => [RpcHandler r] -> Sem (Stop Report : r) () registerHandlers :: forall (r :: EffectRow). Members '[Rpc !! RpcError, Log] r => [RpcHandler r] -> Sem (Stop Report : r) () registerHandlers [RpcHandler r] defs = do ChannelId i <- Sem (Rpc : Stop Report : r) ChannelId -> Sem (Stop Report : r) ChannelId forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a. (Reportable e, Members '[eff !! e, Stop Report] r) => Sem (eff : r) a -> Sem r a resumeReport Sem (Rpc : Stop Report : r) ChannelId forall (r :: EffectRow). Member Rpc r => Sem r ChannelId Rpc.channelId RpcCall () -> Sem (Rpc : Stop Report : r) () forall (r :: EffectRow) a. Member Rpc r => RpcCall a -> Sem r a Rpc.sync ((RpcHandler r -> RpcCall ()) -> [RpcHandler r] -> RpcCall () forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap (ChannelId -> RpcHandler r -> RpcCall () forall (r :: EffectRow). ChannelId -> RpcHandler r -> RpcCall () registerHandler ChannelId i) [RpcHandler r] defs) Sem (Rpc : Stop Report : r) () -> (RpcError -> Sem (Stop Report : r) ()) -> Sem (Stop Report : r) () forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a. Member (Resumable err eff) r => Sem (eff : r) a -> (err -> Sem r a) -> Sem r a !! RpcError -> Sem (Stop Report : r) () forall (r :: EffectRow). Member Log r => RpcError -> Sem r () registerFailed