-- |API functions for echoing messages in Neovim.
module Ribosome.Api.Echo where

import Ribosome.Data.PluginName (PluginName)
import Ribosome.Host.Api.Effect (nvimEcho)
import Ribosome.Host.Class.Msgpack.Array (msgpackArray)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.PluginName (pluginNamePrefixed)

-- |Echo a string, adding it to the message history if the first argument is 'True'.
simpleEcho ::
  Member Rpc r =>
  Bool ->
  Text ->
  Sem r ()
simpleEcho :: forall (r :: EffectRow). Member Rpc r => Bool -> Text -> Sem r ()
simpleEcho Bool
history Text
msg =
  [Object] -> Bool -> Map Text Object -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
[Object] -> Bool -> Map Text Object -> Sem r ()
nvimEcho [Text -> Object
forall a. MsgpackArray a => a
msgpackArray Text
msg] Bool
history Map Text Object
forall a. Monoid a => a
mempty

-- |Echo a string prefixed with the plugin name, adding it to the message history if the first argument is 'True'.
prefixedEcho ::
  Members [Rpc, Reader PluginName] r =>
  Bool ->
  Text ->
  Sem r ()
prefixedEcho :: forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Bool -> Text -> Sem r ()
prefixedEcho Bool
history Text
msg = do
  Text
pref <- Text -> Sem r Text
forall (r :: EffectRow).
Member (Reader PluginName) r =>
Text -> Sem r Text
pluginNamePrefixed Text
msg
  Bool -> Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Bool -> Text -> Sem r ()
simpleEcho Bool
history Text
pref

-- |Echo a string with a highlight group.
echohl ::
  Member Rpc r =>
  Bool ->
  Text ->
  Text ->
  Sem r ()
echohl :: forall (r :: EffectRow).
Member Rpc r =>
Bool -> Text -> Text -> Sem r ()
echohl Bool
history Text
hl Text
msg =
  [Object] -> Bool -> Map Text Object -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
[Object] -> Bool -> Map Text Object -> Sem r ()
nvimEcho [Text -> Text -> Object
forall a. MsgpackArray a => a
msgpackArray Text
msg Text
hl] Bool
history Map Text Object
forall a. Monoid a => a
mempty

-- |Echo a string prefixed with the plugin name, without adding it to the message history.
echo ::
  Members [Rpc, Reader PluginName] r =>
  Text ->
  Sem r ()
echo :: forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Text -> Sem r ()
echo =
  Bool -> Text -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Bool -> Text -> Sem r ()
prefixedEcho Bool
False

-- |Echo a string prefixed with the plugin name and add it to the message history.
echom ::
  Members [Rpc, Reader PluginName] r =>
  Text ->
  Sem r ()
echom :: forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Text -> Sem r ()
echom =
  Bool -> Text -> Sem r ()
forall (r :: EffectRow).
Members '[Rpc, Reader PluginName] r =>
Bool -> Text -> Sem r ()
prefixedEcho Bool
True