-- |An effect used internally to execute handlers when Neovim variables are changed.
module Ribosome.Effect.VariableWatcher where

-- |The name of a variable that Ribosome should watch for changes.
newtype WatchedVariable =
  WatchedVariable { WatchedVariable -> Text
unWatchedVariable :: Text }
  deriving stock (WatchedVariable -> WatchedVariable -> Bool
(WatchedVariable -> WatchedVariable -> Bool)
-> (WatchedVariable -> WatchedVariable -> Bool)
-> Eq WatchedVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchedVariable -> WatchedVariable -> Bool
$c/= :: WatchedVariable -> WatchedVariable -> Bool
== :: WatchedVariable -> WatchedVariable -> Bool
$c== :: WatchedVariable -> WatchedVariable -> Bool
Eq, Int -> WatchedVariable -> ShowS
[WatchedVariable] -> ShowS
WatchedVariable -> String
(Int -> WatchedVariable -> ShowS)
-> (WatchedVariable -> String)
-> ([WatchedVariable] -> ShowS)
-> Show WatchedVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchedVariable] -> ShowS
$cshowList :: [WatchedVariable] -> ShowS
show :: WatchedVariable -> String
$cshow :: WatchedVariable -> String
showsPrec :: Int -> WatchedVariable -> ShowS
$cshowsPrec :: Int -> WatchedVariable -> ShowS
Show)
  deriving newtype (String -> WatchedVariable
(String -> WatchedVariable) -> IsString WatchedVariable
forall a. (String -> a) -> IsString a
fromString :: String -> WatchedVariable
$cfromString :: String -> WatchedVariable
IsString, Eq WatchedVariable
Eq WatchedVariable
-> (WatchedVariable -> WatchedVariable -> Ordering)
-> (WatchedVariable -> WatchedVariable -> Bool)
-> (WatchedVariable -> WatchedVariable -> Bool)
-> (WatchedVariable -> WatchedVariable -> Bool)
-> (WatchedVariable -> WatchedVariable -> Bool)
-> (WatchedVariable -> WatchedVariable -> WatchedVariable)
-> (WatchedVariable -> WatchedVariable -> WatchedVariable)
-> Ord WatchedVariable
WatchedVariable -> WatchedVariable -> Bool
WatchedVariable -> WatchedVariable -> Ordering
WatchedVariable -> WatchedVariable -> WatchedVariable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WatchedVariable -> WatchedVariable -> WatchedVariable
$cmin :: WatchedVariable -> WatchedVariable -> WatchedVariable
max :: WatchedVariable -> WatchedVariable -> WatchedVariable
$cmax :: WatchedVariable -> WatchedVariable -> WatchedVariable
>= :: WatchedVariable -> WatchedVariable -> Bool
$c>= :: WatchedVariable -> WatchedVariable -> Bool
> :: WatchedVariable -> WatchedVariable -> Bool
$c> :: WatchedVariable -> WatchedVariable -> Bool
<= :: WatchedVariable -> WatchedVariable -> Bool
$c<= :: WatchedVariable -> WatchedVariable -> Bool
< :: WatchedVariable -> WatchedVariable -> Bool
$c< :: WatchedVariable -> WatchedVariable -> Bool
compare :: WatchedVariable -> WatchedVariable -> Ordering
$ccompare :: WatchedVariable -> WatchedVariable -> Ordering
Ord)

-- |An effect used internally to execute handlers when Neovim variables are changed.
data VariableWatcher :: Effect where
  -- |Called when the internal logic determines that variables should be examined for updates.
  Update :: VariableWatcher m ()
  -- |Stop running update handlers for the given variable.
  Unwatch :: WatchedVariable -> VariableWatcher m ()

makeSem_ ''VariableWatcher

-- |Called when the internal logic determines that variables should be examined for updates.
update ::
  Member VariableWatcher r =>
  Sem r ()

-- |Stop running update handlers for the given variable.
unwatch ::
  Member VariableWatcher r =>
  WatchedVariable ->
  Sem r ()