module Ribosome.Api.Variable where

import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)
import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))
import Ribosome.Nvim.Api.IO (vimSetVar)

setVar ::
  NvimE e m =>
  MsgpackEncode a =>
  Text ->
  a ->
  m ()
setVar :: Text -> a -> m ()
setVar Text
name =
  Text -> Object -> m ()
forall (m :: * -> *) e a.
(Nvim m, MonadDeepError e RpcError m, MsgpackDecode a) =>
Text -> Object -> m a
vimSetVar Text
name (Object -> m ()) -> (a -> Object) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack

setPVar ::
  MonadRibo m =>
  NvimE e m =>
  MsgpackEncode a =>
  Text ->
  a ->
  m ()
setPVar :: Text -> a -> m ()
setPVar Text
name a
a = do
  Text
pn <- m Text
forall (m :: * -> *). MonadRibo m => m Text
pluginName
  Text -> a -> m ()
forall e (m :: * -> *) a.
(NvimE e m, MsgpackEncode a) =>
Text -> a -> m ()
setVar (Text
pn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) a
a