module Ribosome.Plugin (
  module Ribosome.Plugin,
  rpcHandler,
  rpcHandlerDef,
  RpcHandlerConfig(..),
  RpcDef(..),
) where

import qualified Data.Map.Strict as Map ()
import Data.MessagePack (Object(ObjectNil, ObjectBool))
import Neovim.Context (Neovim)
import Neovim.Plugin.Classes (
  AutocmdOptions(acmdPattern),
  CommandOption,
  FunctionName(..),
  FunctionalityDescription(..),
  Synchronous(..),
  )
import Neovim.Plugin.Internal (ExportedFunctionality(..), Plugin(..))

import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE)
import Ribosome.Data.Mapping (MappingError)
import Ribosome.Data.Text (capitalize)
import Ribosome.Plugin.TH (rpcHandler, rpcHandlerDef)
import Ribosome.Plugin.Builtin (deleteScratchRpc)
import Ribosome.Plugin.Mapping (MappingHandler, handleMappingRequest)
import Ribosome.Plugin.RpcHandler (RpcHandler(..))
import Ribosome.Plugin.TH.Handler (
  RpcDef(RpcDef),
  RpcDefDetail(..),
  RpcHandlerConfig(..),
  rhcCmd,
  )
import Ribosome.Plugin.Watch (handleWatcherRequestSafe, watchedVariables)

poll ::
  Monad m =>
  [Object] ->
  m Object
poll :: [Object] -> m Object
poll [Object]
_ =
  Object -> m Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Object
ObjectBool Bool
True)

pollRpc ::
  MonadDeepError e MappingError m =>
  Text ->
  RpcDef m
pollRpc :: Text -> RpcDef m
pollRpc Text
pluginName =
  RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
forall (m :: * -> *).
RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
RpcDef (Synchronous -> RpcDefDetail
RpcFunction Synchronous
Sync) (Text -> Text
capitalize Text
pluginName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Poll") [Object] -> m Object
forall (m :: * -> *). Monad m => [Object] -> m Object
poll

mappingHandlerRpc ::
  MonadDeepError e MappingError m =>
  Text ->
  [MappingHandler m] ->
  RpcDef m
mappingHandlerRpc :: Text -> [MappingHandler m] -> RpcDef m
mappingHandlerRpc Text
pluginName [MappingHandler m]
mappings =
  RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
forall (m :: * -> *).
RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
RpcDef (Synchronous -> RpcDefDetail
RpcFunction Synchronous
Async) (Text -> Text
capitalize Text
pluginName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Mapping") ([MappingHandler m] -> [Object] -> m Object
forall e (m :: * -> *).
MonadDeepError e MappingError m =>
[MappingHandler m] -> [Object] -> m Object
handleMappingRequest [MappingHandler m]
mappings)

watcherRpc ::
  MonadBaseControl IO m =>
  MonadRibo m =>
  NvimE e m =>
  Text ->
  Map Text (Object -> m ()) ->
  [RpcDef m]
watcherRpc :: Text -> Map Text (Object -> m ()) -> [RpcDef m]
watcherRpc Text
pluginName Map Text (Object -> m ())
variables =
  RpcDef m
chromatinInit RpcDef m -> [RpcDef m] -> [RpcDef m]
forall a. a -> [a] -> [a]
: (Text -> RpcDef m
rpcDef (Text -> RpcDef m) -> [Text] -> [RpcDef m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Item [Text]
"CmdlineLeave", Item [Text]
"BufWinEnter", Item [Text]
"VimEnter"])
  where
    chromatinInit :: RpcDef m
chromatinInit = RpcDefDetail -> Text -> RpcDef m
rpcDefFromDetail ((Text -> RpcDefDetail
detail Text
"User") { $sel:raOptions:RpcFunction :: AutocmdOptions
raOptions = AutocmdOptions
forall a. Default a => a
def { acmdPattern :: String
acmdPattern = Text -> String
forall a. ToString a => a -> String
toString Text
ciName } }) Text
ciName
    ciName :: Text
ciName = Text
"ChromatinInitialized"
    rpcDef :: Text -> RpcDef m
rpcDef Text
event =
      RpcDefDetail -> Text -> RpcDef m
rpcDefFromDetail (Text -> RpcDefDetail
detail Text
event) Text
event
    rpcDefFromDetail :: RpcDefDetail -> Text -> RpcDef m
rpcDefFromDetail RpcDefDetail
dt Text
event =
      RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
forall (m :: * -> *).
RpcDefDetail -> Text -> ([Object] -> m Object) -> RpcDef m
RpcDef RpcDefDetail
dt (Text -> Text
name' Text
event) ([WatchedVariable m] -> [Object] -> m Object
forall (m :: * -> *) e.
(MonadBaseControl IO m, MonadRibo m, NvimE e m) =>
[WatchedVariable m] -> [Object] -> m Object
handleWatcherRequestSafe (Map Text (Object -> m ()) -> [WatchedVariable m]
forall (m :: * -> *).
Map Text (Object -> m ()) -> [WatchedVariable m]
watchedVariables Map Text (Object -> m ())
variables))
    name' :: Text -> Text
name' Text
event = Text -> Text
capitalize Text
pluginName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"VariableChanged" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
event
    detail :: Text -> RpcDefDetail
detail Text
event = Text -> Synchronous -> AutocmdOptions -> RpcDefDetail
RpcAutocmd Text
event Synchronous
Async AutocmdOptions
forall a. Default a => a
def

compileRpcDef ::
  RpcHandler e env m =>
  (e -> m ()) ->
  RpcDef m ->
  ExportedFunctionality env
compileRpcDef :: (e -> m ()) -> RpcDef m -> ExportedFunctionality env
compileRpcDef e -> m ()
errorHandler (RpcDef RpcDefDetail
detail Text
name' [Object] -> m Object
rpcHandler') =
  (FunctionalityDescription, [Object] -> Neovim env Object)
-> ExportedFunctionality env
forall env.
(FunctionalityDescription, [Object] -> Neovim env Object)
-> ExportedFunctionality env
EF (RpcDefDetail -> FunctionName -> FunctionalityDescription
wrapDetail RpcDefDetail
detail (ByteString -> FunctionName
F (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
name')), (e -> m ())
-> ([Object] -> m Object) -> [Object] -> Neovim env Object
forall e env (m :: * -> *).
RpcHandler e env m =>
(e -> m ())
-> ([Object] -> m Object) -> [Object] -> Neovim env Object
executeRpcHandler e -> m ()
errorHandler [Object] -> m Object
rpcHandler')
  where
    wrapDetail :: RpcDefDetail -> FunctionName -> FunctionalityDescription
wrapDetail (RpcFunction Synchronous
sync') FunctionName
n =
      FunctionName -> Synchronous -> FunctionalityDescription
Function FunctionName
n Synchronous
sync'
    wrapDetail (RpcCommand CommandOptions
options) FunctionName
n =
      FunctionName -> CommandOptions -> FunctionalityDescription
Command FunctionName
n CommandOptions
options
    wrapDetail (RpcAutocmd Text
event Synchronous
sync' AutocmdOptions
options) FunctionName
n =
      ByteString
-> FunctionName
-> Synchronous
-> AutocmdOptions
-> FunctionalityDescription
Autocmd (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
event) FunctionName
n Synchronous
sync' AutocmdOptions
options

nvimPlugin ::
  RpcHandler e env m =>
  env ->
  [[RpcDef m]] ->
  (e -> m ()) ->
  Plugin env
nvimPlugin :: env -> [[RpcDef m]] -> (e -> m ()) -> Plugin env
nvimPlugin env
env [[RpcDef m]]
rpcDefs e -> m ()
errorHandler =
  env -> [ExportedFunctionality env] -> Plugin env
forall env. env -> [ExportedFunctionality env] -> Plugin env
Plugin env
env ((e -> m ()) -> RpcDef m -> ExportedFunctionality env
forall e env (m :: * -> *).
RpcHandler e env m =>
(e -> m ()) -> RpcDef m -> ExportedFunctionality env
compileRpcDef e -> m ()
errorHandler (RpcDef m -> ExportedFunctionality env)
-> [RpcDef m] -> [ExportedFunctionality env]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[RpcDef m]] -> [RpcDef m]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[RpcDef m]]
rpcDefs)

riboPlugin ::
  MonadBaseControl IO m =>
  MonadDeepError e MappingError m =>
  MonadRibo m =>
  NvimE e m =>
  RpcHandler e env m =>
  Text ->
  env ->
  [[RpcDef m]] ->
  [MappingHandler m] ->
  (e -> m ()) ->
  Map Text (Object -> m ()) ->
  Plugin env
riboPlugin :: Text
-> env
-> [[RpcDef m]]
-> [MappingHandler m]
-> (e -> m ())
-> Map Text (Object -> m ())
-> Plugin env
riboPlugin Text
pluginName env
env [[RpcDef m]]
rpcDefs [MappingHandler m]
mappings e -> m ()
errorHandler Map Text (Object -> m ())
variables =
  env -> [ExportedFunctionality env] -> Plugin env
forall env. env -> [ExportedFunctionality env] -> Plugin env
Plugin env
env (((e -> m ()) -> RpcDef m -> ExportedFunctionality env
forall e env (m :: * -> *).
RpcHandler e env m =>
(e -> m ()) -> RpcDef m -> ExportedFunctionality env
compileRpcDef e -> m ()
errorHandler (RpcDef m -> ExportedFunctionality env)
-> [RpcDef m] -> [ExportedFunctionality env]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RpcDef m]
extra) [ExportedFunctionality env]
-> [ExportedFunctionality env] -> [ExportedFunctionality env]
forall a. [a] -> [a] -> [a]
++ [ExportedFunctionality env]
efs)
  where
    Plugin env
_ [ExportedFunctionality env]
efs = env -> [[RpcDef m]] -> (e -> m ()) -> Plugin env
forall e env (m :: * -> *).
RpcHandler e env m =>
env -> [[RpcDef m]] -> (e -> m ()) -> Plugin env
nvimPlugin env
env [[RpcDef m]]
rpcDefs e -> m ()
errorHandler
    extra :: [RpcDef m]
extra = Text -> RpcDef m
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> RpcDef m
deleteScratchRpc Text
pluginName RpcDef m -> [RpcDef m] -> [RpcDef m]
forall a. a -> [a] -> [a]
: Text -> RpcDef m
forall e (m :: * -> *).
MonadDeepError e MappingError m =>
Text -> RpcDef m
pollRpc Text
pluginName RpcDef m -> [RpcDef m] -> [RpcDef m]
forall a. a -> [a] -> [a]
: Text -> [MappingHandler m] -> RpcDef m
forall e (m :: * -> *).
MonadDeepError e MappingError m =>
Text -> [MappingHandler m] -> RpcDef m
mappingHandlerRpc Text
pluginName [MappingHandler m]
mappings RpcDef m -> [RpcDef m] -> [RpcDef m]
forall a. a -> [a] -> [a]
: [RpcDef m]
watch
    watch :: [RpcDef m]
watch = Text -> Map Text (Object -> m ()) -> [RpcDef m]
forall (m :: * -> *) e.
(MonadBaseControl IO m, MonadRibo m, NvimE e m) =>
Text -> Map Text (Object -> m ()) -> [RpcDef m]
watcherRpc Text
pluginName Map Text (Object -> m ())
variables

executeRpcHandler ::
  ∀ e env m.
  RpcHandler e env m =>
  (e -> m ()) ->
  ([Object] -> m Object) ->
  [Object] ->
  Neovim env Object
executeRpcHandler :: (e -> m ())
-> ([Object] -> m Object) -> [Object] -> Neovim env Object
executeRpcHandler e -> m ()
errorHandler [Object] -> m Object
rpcHandler' =
  (e -> Neovim env Object)
-> (Object -> Neovim env Object)
-> Either e Object
-> Neovim env Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Neovim env Object
handleError Object -> Neovim env Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e Object -> Neovim env Object)
-> ([Object] -> Neovim env (Either e Object))
-> [Object]
-> Neovim env Object
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT e (Neovim env) Object -> Neovim env (Either e Object)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e (Neovim env) Object -> Neovim env (Either e Object))
-> ([Object] -> ExceptT e (Neovim env) Object)
-> [Object]
-> Neovim env (Either e Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Object -> ExceptT e (Neovim env) Object
forall e env (m :: * -> *) a.
RpcHandler e env m =>
m a -> ExceptT e (Neovim env) a
native (m Object -> ExceptT e (Neovim env) Object)
-> ([Object] -> m Object)
-> [Object]
-> ExceptT e (Neovim env) Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Object] -> m Object
rpcHandler'
  where
    handleError :: e -> Neovim env Object
handleError e
e =
      Object
ObjectNil Object -> Neovim env (Either e ()) -> Neovim env Object
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ExceptT e (Neovim env) () -> Neovim env (Either e ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e (Neovim env) () -> Neovim env (Either e ()))
-> (e -> ExceptT e (Neovim env) ())
-> e
-> Neovim env (Either e ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e env (m :: * -> *) a.
RpcHandler e env m =>
m a -> ExceptT e (Neovim env) a
forall env (m :: * -> *) a.
RpcHandler e env m =>
m a -> ExceptT e (Neovim env) a
native @e (m () -> ExceptT e (Neovim env) ())
-> (e -> m ()) -> e -> ExceptT e (Neovim env) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m ()
errorHandler (e -> Neovim env (Either e ())) -> e -> Neovim env (Either e ())
forall a b. (a -> b) -> a -> b
$ e
e)

cmd :: [CommandOption] -> RpcHandlerConfig -> RpcHandlerConfig
cmd :: [CommandOption] -> RpcHandlerConfig -> RpcHandlerConfig
cmd [CommandOption]
opts RpcHandlerConfig
conf =
  RpcHandlerConfig
conf { $sel:rhcCmd:RpcHandlerConfig :: Maybe [CommandOption]
rhcCmd = [CommandOption] -> Maybe [CommandOption]
forall a. a -> Maybe a
Just [CommandOption]
opts }

sync :: RpcHandlerConfig -> RpcHandlerConfig
sync :: RpcHandlerConfig -> RpcHandlerConfig
sync RpcHandlerConfig
conf =
  RpcHandlerConfig
conf { $sel:rhcSync:RpcHandlerConfig :: Synchronous
rhcSync = Synchronous
Sync }

name :: Text -> RpcHandlerConfig -> RpcHandlerConfig
name :: Text -> RpcHandlerConfig -> RpcHandlerConfig
name Text
n RpcHandlerConfig
conf =
  RpcHandlerConfig
conf { $sel:rhcName:RpcHandlerConfig :: Maybe Text
rhcName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n }

autocmd :: Text -> RpcHandlerConfig -> RpcHandlerConfig
autocmd :: Text -> RpcHandlerConfig -> RpcHandlerConfig
autocmd Text
event RpcHandlerConfig
conf =
  RpcHandlerConfig
conf { $sel:rhcAutocmd:RpcHandlerConfig :: Maybe Text
rhcAutocmd = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
event }

autocmdOptions :: AutocmdOptions -> RpcHandlerConfig -> RpcHandlerConfig
autocmdOptions :: AutocmdOptions -> RpcHandlerConfig -> RpcHandlerConfig
autocmdOptions AutocmdOptions
options RpcHandlerConfig
conf =
  RpcHandlerConfig
conf { $sel:rhcAutocmdOptions:RpcHandlerConfig :: Maybe AutocmdOptions
rhcAutocmdOptions = AutocmdOptions -> Maybe AutocmdOptions
forall a. a -> Maybe a
Just AutocmdOptions
options }