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