-- |Interceptor that adds internal RPC handlers to the host.
module Ribosome.Plugin.Builtin where

import Exon (exon)
import Prelude hiding (group)

import Ribosome.Data.PluginName (PluginName (PluginName))
import Ribosome.Data.ScratchId (ScratchId)
import qualified Ribosome.Effect.Scratch as Scratch
import Ribosome.Effect.Scratch (Scratch)
import qualified Ribosome.Effect.VariableWatcher as VariableWatcher
import Ribosome.Effect.VariableWatcher (VariableWatcher)
import Ribosome.Host.Data.BootError (BootError)
import Ribosome.Host.Data.Execution (Execution (Async))
import Ribosome.Host.Data.Report (Report, resumeReport)
import Ribosome.Host.Data.RpcError (RpcError)
import Ribosome.Host.Data.RpcHandler (Handler, RpcHandler)
import Ribosome.Host.Data.RpcName (RpcName (RpcName))
import Ribosome.Host.Data.RpcType (AutocmdGroup (AutocmdGroup), AutocmdOptions (target), AutocmdPatterns, group)
import Ribosome.Host.Effect.Handlers (Handlers)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.Handler (rpcAutocmd, rpcFunction)
import Ribosome.Host.Interpreter.Handlers (withHandlers)
import Ribosome.Text (capitalize)

-- |The set of autocmds that should trigger an update in 'VariableWatcher'.
watcherEvents :: [(Text, AutocmdPatterns)]
watcherEvents :: [(Text, AutocmdPatterns)]
watcherEvents =
  [
    (Text
"CmdlineLeave", AutocmdPatterns
forall a. Default a => a
def),
    (Text
"BufWinEnter", AutocmdPatterns
forall a. Default a => a
def),
    (Text
"VimEnter", AutocmdPatterns
forall a. Default a => a
def),
    (Text
"User", AutocmdPatterns
"RibosomeUpdateVariables")
  ]

-- |Run 'VariableWatcher.update' and restop errors.
updateVar ::
  Member (VariableWatcher !! Report) r =>
  Handler r ()
updateVar :: forall (r :: EffectRow).
Member (VariableWatcher !! Report) r =>
Handler r ()
updateVar =
  Sem (VariableWatcher : Stop Report : r) ()
-> Sem (Stop Report : r) ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop Sem (VariableWatcher : Stop Report : r) ()
forall (r :: EffectRow). Member VariableWatcher r => Sem r ()
VariableWatcher.update

-- |Declare an autocmd that triggers the variable watcher.
watcherRpc ::
  ∀ r .
  Member (VariableWatcher !! Report) r =>
  PluginName ->
  Text ->
  AutocmdPatterns ->
  RpcHandler r
watcherRpc :: forall (r :: EffectRow).
Member (VariableWatcher !! Report) r =>
PluginName -> Text -> AutocmdPatterns -> RpcHandler r
watcherRpc (PluginName Text
name) Text
event AutocmdPatterns
pat =
  RpcName
-> Execution
-> AutocmdEvents
-> AutocmdOptions
-> Handler r ()
-> RpcHandler r
forall (r :: EffectRow) h.
HandlerCodec h r =>
RpcName
-> Execution
-> AutocmdEvents
-> AutocmdOptions
-> h
-> RpcHandler r
rpcAutocmd (Text -> RpcName
RpcName Text
method) Execution
Async (Text -> AutocmdEvents
forall a. IsString a => Text -> a
fromText Text
event) AutocmdOptions
forall a. Default a => a
def { $sel:target:AutocmdOptions :: Either AutocmdBuffer AutocmdPatterns
target = AutocmdPatterns -> Either AutocmdBuffer AutocmdPatterns
forall a b. b -> Either a b
Right AutocmdPatterns
pat, $sel:group:AutocmdOptions :: Maybe AutocmdGroup
group = AutocmdGroup -> Maybe AutocmdGroup
forall a. a -> Maybe a
Just (Text -> AutocmdGroup
AutocmdGroup Text
name) } do
    Handler r ()
forall (r :: EffectRow).
Member (VariableWatcher !! Report) r =>
Handler r ()
updateVar
  where
    method :: Text
method =
      [exon|#{capitalize name}VariableChanged#{event}|]

-- |Delete a scratch buffer.
deleteScratch ::
  Member (Scratch !! RpcError) r =>
  ScratchId ->
  Handler r ()
deleteScratch :: forall (r :: EffectRow).
Member (Scratch !! RpcError) r =>
ScratchId -> Handler r ()
deleteScratch =
  Sem (Scratch : Stop Report : r) () -> Sem (Stop Report : r) ()
forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport (Sem (Scratch : Stop Report : r) () -> Sem (Stop Report : r) ())
-> (ScratchId -> Sem (Scratch : Stop Report : r) ())
-> ScratchId
-> Sem (Stop Report : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScratchId -> Sem (Scratch : Stop Report : r) ()
forall (r :: EffectRow). Member Scratch r => ScratchId -> Sem r ()
Scratch.delete

-- |The name for the handler that is triggered by a scratch buffer being deleted.
deleteName :: PluginName -> RpcName
deleteName :: PluginName -> RpcName
deleteName (PluginName Text
name) =
  Text -> RpcName
RpcName [exon|#{capitalize name}DeleteScratch|]

-- |A set of 'RpcHandler's for internal tasks.
builtinHandlers ::
  ∀ r .
  Members [Scratch !! RpcError, VariableWatcher !! Report] r =>
  PluginName ->
  [RpcHandler r]
builtinHandlers :: forall (r :: EffectRow).
Members '[Scratch !! RpcError, VariableWatcher !! Report] r =>
PluginName -> [RpcHandler r]
builtinHandlers PluginName
name =
  RpcName -> Execution -> (ScratchId -> Handler r ()) -> RpcHandler r
forall (r :: EffectRow) h.
HandlerCodec h r =>
RpcName -> Execution -> h -> RpcHandler r
rpcFunction (PluginName -> RpcName
deleteName PluginName
name) Execution
Async ScratchId -> Handler r ()
forall (r :: EffectRow).
Member (Scratch !! RpcError) r =>
ScratchId -> Handler r ()
deleteScratch RpcHandler r -> [RpcHandler r] -> [RpcHandler r]
forall a. a -> [a] -> [a]
: ((Text -> AutocmdPatterns -> RpcHandler r)
-> (Text, AutocmdPatterns) -> RpcHandler r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PluginName -> Text -> AutocmdPatterns -> RpcHandler r
forall (r :: EffectRow).
Member (VariableWatcher !! Report) r =>
PluginName -> Text -> AutocmdPatterns -> RpcHandler r
watcherRpc PluginName
name) ((Text, AutocmdPatterns) -> RpcHandler r)
-> [(Text, AutocmdPatterns)] -> [RpcHandler r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, AutocmdPatterns)]
watcherEvents)

-- |The dependencies of the builtin handlers.
type BuiltinHandlersDeps =
  [
    VariableWatcher !! Report,
    Handlers !! Report,
    Scratch !! RpcError,
    Rpc !! RpcError,
    Reader PluginName,
    Error BootError,
    Log
  ]

-- |Add builtin handlers to 'Handlers' without removing the effect from the stack.
interceptHandlersBuiltin ::
  Members BuiltinHandlersDeps r =>
  Sem r a ->
  Sem r a
interceptHandlersBuiltin :: forall (r :: EffectRow) a.
Members BuiltinHandlersDeps r =>
Sem r a -> Sem r a
interceptHandlersBuiltin Sem r a
sem = do
  PluginName
name <- Sem r PluginName
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  [RpcHandler r] -> Sem r a -> Sem r a
forall (r :: EffectRow) a.
Members
  '[Handlers !! Report, Rpc !! RpcError, Log, Error BootError] r =>
[RpcHandler r] -> Sem r a -> Sem r a
withHandlers (PluginName -> [RpcHandler r]
forall (r :: EffectRow).
Members '[Scratch !! RpcError, VariableWatcher !! Report] r =>
PluginName -> [RpcHandler r]
builtinHandlers PluginName
name) Sem r a
sem