module Ribosome.Api.Echo where

import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)
import Ribosome.Data.Text (escapeQuotes)
import Ribosome.Nvim.Api.IO (vimCommand)

echoWith :: NvimE e m => Text -> Text -> m ()
echoWith :: Text -> Text -> m ()
echoWith Text
cmd Text
msg =
  Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Text -> m ()
vimCommand (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeQuotes Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

echoWithName :: MonadRibo m => NvimE e m => Text -> Text -> m ()
echoWithName :: Text -> Text -> m ()
echoWithName Text
cmd Text
msg = do
  Text
name <- m Text
forall (m :: * -> *). MonadRibo m => m Text
pluginName
  Text -> Text -> m ()
forall e (m :: * -> *). NvimE e m => Text -> Text -> m ()
echoWith Text
cmd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg

echo' :: NvimE e m => Text -> m ()
echo' :: Text -> m ()
echo' =
  Text -> Text -> m ()
forall e (m :: * -> *). NvimE e m => Text -> Text -> m ()
echoWith Text
"echo"

echo :: MonadRibo m => NvimE e m => Text -> m ()
echo :: Text -> m ()
echo =
  Text -> Text -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> Text -> m ()
echoWithName Text
"echo"

echom' :: NvimE e m => Text -> m ()
echom' :: Text -> m ()
echom' =
  Text -> Text -> m ()
forall e (m :: * -> *). NvimE e m => Text -> Text -> m ()
echoWith Text
"echom"

echom :: MonadRibo m => NvimE e m => Text -> m ()
echom :: Text -> m ()
echom =
  Text -> Text -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> Text -> m ()
echoWithName Text
"echom"

echomS ::
  MonadRibo m =>
  NvimE e m =>
  Show a =>
  a ->
  m ()
echomS :: a -> m ()
echomS = Text -> m ()
forall (m :: * -> *) e. (MonadRibo m, NvimE e m) => Text -> m ()
echom (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall b a. (Show a, IsString b) => a -> b
show

echon :: MonadRibo m => NvimE e m => Text -> m ()
echon :: Text -> m ()
echon =
  Text -> Text -> m ()
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m) =>
Text -> Text -> m ()
echoWithName Text
"echom"

echohl :: NvimE e m => Text -> m ()
echohl :: Text -> m ()
echohl =
  Text -> m ()
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
Text -> m ()
vimCommand (Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"echohl " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)