-- |Defining Neovim functions.
module Ribosome.Api.Function where

import qualified Data.Text as Text
import Exon (exon)

import Ribosome.Host.Api.Effect (nvimExec)
import Ribosome.Host.Effect.Rpc (Rpc)

-- |Define a Neovim function.
defineFunction ::
  Member Rpc r =>
  -- |Function name.
  Text ->
  -- |Function parameters.
  [Text] ->
  -- |Vimscript lines that form the function body.
  [Text] ->
  Sem r ()
defineFunction :: forall (r :: EffectRow).
Member Rpc r =>
Text -> [Text] -> [Text] -> Sem r ()
defineFunction Text
name [Text]
params [Text]
body =
  Sem r Text -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Text -> Sem r ()) -> Sem r Text -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Sem r Text
forall (r :: EffectRow). Member Rpc r => Text -> Bool -> Sem r Text
nvimExec ([Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines (Text
sig Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
body [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Item [Text]
"endfunction"])) Bool
True
  where
    sig :: Text
sig =
      [exon|function! #{name}(#{Text.intercalate ", " params})|]