-- |Interpreters for 'VariableWatcher'
module Ribosome.Interpreter.VariableWatcher where

import Conc (interpretAtomic, interpretLockReentrant, lockOrSkip_)
import qualified Data.Map.Strict as Map
import Data.MessagePack (Object (ObjectNil))

import Ribosome.Effect.VariableWatcher (WatchedVariable (WatchedVariable))
import qualified Ribosome.Effect.VariableWatcher as VariableWatcher
import Ribosome.Effect.VariableWatcher (VariableWatcher)
import Ribosome.Host.Api.Effect (nvimGetVar)
import Ribosome.Host.Data.Report (Report)
import Ribosome.Host.Data.RpcError (RpcError)
import Ribosome.Host.Data.RpcHandler (Handler)
import Ribosome.Host.Effect.Rpc (Rpc)

-- |Interpret 'VariableWatcher' by doing nothing.
interpretVariableWatcherNull :: InterpreterFor (VariableWatcher !! Report) r
interpretVariableWatcherNull :: forall (r :: [Effect]).
InterpreterFor (VariableWatcher !! Report) r
interpretVariableWatcherNull =
  (forall x (r0 :: [Effect]).
 VariableWatcher (Sem r0) x -> Sem (Stop Report : r) x)
-> InterpreterFor (VariableWatcher !! Report) r
forall err (eff :: Effect) (r :: [Effect]).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable \case
    VariableWatcher (Sem r0) x
VariableWatcher.Update -> Sem (Stop Report : r) x
forall (f :: * -> *). Applicative f => f ()
unit
    VariableWatcher.Unwatch WatchedVariable
_ -> Sem (Stop Report : r) x
forall (f :: * -> *). Applicative f => f ()
unit

-- |Run the handler if the two 'Object's are different.
runIfDifferent ::
  (Object -> Handler r ()) ->
  Object ->
  Object ->
  Handler r ()
runIfDifferent :: forall (r :: [Effect]).
(Object -> Handler r ()) -> Object -> Object -> Handler r ()
runIfDifferent Object -> Handler r ()
handler Object
new Object
old =
  Bool -> Handler r () -> Handler r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Object
old Object -> Object -> Bool
forall a. Eq a => a -> a -> Bool
== Object
new) (Object -> Handler r ()
handler Object
new)

-- |Fetch the current value of the watched variable and call the handler if its value has changed.
checkVar ::
  Member (Rpc !! RpcError) r =>
  WatchedVariable ->
  Object ->
  (Object -> Handler r ()) ->
  Handler r Object
checkVar :: forall (r :: [Effect]).
Member (Rpc !! RpcError) r =>
WatchedVariable
-> Object -> (Object -> Handler r ()) -> Handler r Object
checkVar (WatchedVariable Text
var) Object
old Object -> Handler r ()
handler =
  Object
-> Sem (Rpc : Stop Report : r) Object
-> Sem (Stop Report : r) Object
forall err (eff :: Effect) (r :: [Effect]) a.
Member (Resumable err eff) r =>
a -> Sem (eff : r) a -> Sem r a
resumeAs Object
old do
    Object
new <- Text -> Sem (Rpc : Stop Report : r) Object
forall a (r :: [Effect]).
(Member Rpc r, MsgpackDecode a) =>
Text -> Sem r a
nvimGetVar Text
var
    Object
new Object
-> Sem (Rpc : Stop Report : r) ()
-> Sem (Rpc : Stop Report : r) Object
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Handler r () -> Sem (Rpc : Stop Report : r) ()
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise ((Object -> Handler r ()) -> Object -> Object -> Handler r ()
forall (r :: [Effect]).
(Object -> Handler r ()) -> Object -> Object -> Handler r ()
runIfDifferent Object -> Handler r ()
handler Object
new Object
old)

-- |This is a reactive system that is triggered by several frequently sent autocommands to inspect a user-defined set of
-- Neovim variables for changes.
-- When a variable's value has been observed to have changed from the previously recorded state, the associated handler
-- is executed.
--
-- This handler has to be passed to 'Ribosome.runNvimPluginIO' or similar as part of the custom effect stack, like:
--
-- > runNvimPluginIO "my-plugin" (watchVariables [("variable_name", handler)]) mempty
--
-- This does not remove 'VariableWatcher' from the stack, but intercepts and resends it, to make it simpler to use
-- with the plugin runners.
watchVariables ::
  Members [VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r =>
  Map WatchedVariable (Object -> Handler r ()) ->
  Sem r a ->
  Sem r a
watchVariables :: forall mres (r :: [Effect]) a.
Members
  '[VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres,
    Race, Embed IO]
  r =>
Map WatchedVariable (Object -> Handler r ()) -> Sem r a -> Sem r a
watchVariables Map WatchedVariable (Object -> Handler r ())
vars =
  Sem (Lock : r) a -> Sem r a
forall mres (r :: [Effect]).
Members '[Resource, Race, Mask mres, Embed IO] r =>
InterpreterFor Lock r
interpretLockReentrant (Sem (Lock : r) a -> Sem r a)
-> (Sem r a -> Sem (Lock : r) a) -> Sem r a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Map WatchedVariable (Object, Object -> Handler r ())
-> InterpreterFor
     (AtomicState
        (Map WatchedVariable (Object, Object -> Handler r ())))
     (Lock : r)
forall a (r :: [Effect]).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic ((Object
ObjectNil,) ((Object -> Handler r ()) -> (Object, Object -> Handler r ()))
-> Map WatchedVariable (Object -> Handler r ())
-> Map WatchedVariable (Object, Object -> Handler r ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map WatchedVariable (Object -> Handler r ())
vars) (Sem
   (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
      : Lock : r)
   a
 -> Sem (Lock : r) a)
-> (Sem r a
    -> Sem
         (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
            : Lock : r)
         a)
-> Sem r a
-> Sem (Lock : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall x (r0 :: [Effect]).
 VariableWatcher (Sem r0) x
 -> Sem
      (Stop Report
         : AtomicState
             (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      x)
-> Sem
     (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     a
-> Sem
     (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     a
forall err (eff :: Effect) (r :: [Effect]) a.
(Member (Resumable err eff) r,
 FirstOrder eff "interceptResumable") =>
(forall x (r0 :: [Effect]). eff (Sem r0) x -> Sem (Stop err : r) x)
-> Sem r a -> Sem r a
interceptResumable \case
    VariableWatcher (Sem r0) x
VariableWatcher.Update -> do
      Sem
  (Stop Report
     : AtomicState
         (Map WatchedVariable (Object, Object -> Handler r ()))
     : Lock : r)
  ()
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     ()
forall (r :: [Effect]) a. Member Lock r => Sem r a -> Sem r ()
lockOrSkip_ do
        Map WatchedVariable (Object, Object -> Handler r ())
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     ()
forall s (r :: [Effect]). Member (AtomicState s) r => s -> Sem r ()
atomicPut (Map WatchedVariable (Object, Object -> Handler r ())
 -> Sem
      (Stop Report
         : AtomicState
             (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      ())
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     (Map WatchedVariable (Object, Object -> Handler r ()))
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WatchedVariable
 -> (Object, Object -> Handler r ())
 -> Sem
      (Stop Report
         : AtomicState
             (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      (Object, Object -> Handler r ()))
-> Map WatchedVariable (Object, Object -> Handler r ())
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     (Map WatchedVariable (Object, Object -> Handler r ()))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\ WatchedVariable
var (Object
old, Object -> Handler r ()
h) -> (,Object -> Handler r ()
h) (Object -> (Object, Object -> Handler r ()))
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     Object
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     (Object, Object -> Handler r ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Stop Report : r) Object
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     Object
forall (e2 :: Effect) (e3 :: Effect) (e1 :: Effect) (r :: [Effect])
       a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 (WatchedVariable
-> Object
-> (Object -> Handler r ())
-> Sem (Stop Report : r) Object
forall (r :: [Effect]).
Member (Rpc !! RpcError) r =>
WatchedVariable
-> Object -> (Object -> Handler r ()) -> Handler r Object
checkVar WatchedVariable
var Object
old Object -> Handler r ()
h)) (Map WatchedVariable (Object, Object -> Handler r ())
 -> Sem
      (Stop Report
         : AtomicState
             (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      (Map WatchedVariable (Object, Object -> Handler r ())))
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     (Map WatchedVariable (Object, Object -> Handler r ()))
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     (Map WatchedVariable (Object, Object -> Handler r ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem
  (Stop Report
     : AtomicState
         (Map WatchedVariable (Object, Object -> Handler r ()))
     : Lock : r)
  (Map WatchedVariable (Object, Object -> Handler r ()))
forall s (r :: [Effect]). Member (AtomicState s) r => Sem r s
atomicGet
      forall err (eff :: Effect) (r :: [Effect]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @Report Sem
  (VariableWatcher
     : Stop Report
     : AtomicState
         (Map WatchedVariable (Object, Object -> Handler r ()))
     : Lock : r)
  ()
forall (r :: [Effect]). Member VariableWatcher r => Sem r ()
VariableWatcher.update
    VariableWatcher.Unwatch WatchedVariable
var -> do
      (Map WatchedVariable (Object, Object -> Handler r ())
 -> Map WatchedVariable (Object, Object -> Handler r ()))
-> Sem
     (Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     ()
forall s (r :: [Effect]).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (WatchedVariable
-> Map WatchedVariable (Object, Object -> Handler r ())
-> Map WatchedVariable (Object, Object -> Handler r ())
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete WatchedVariable
var)
      forall err (eff :: Effect) (r :: [Effect]).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
restop @Report (WatchedVariable
-> Sem
     (VariableWatcher
        : Stop Report
        : AtomicState
            (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     ()
forall (r :: [Effect]).
Member VariableWatcher r =>
WatchedVariable -> Sem r ()
VariableWatcher.unwatch WatchedVariable
var)
  (Sem
   (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
      : Lock : r)
   a
 -> Sem
      (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      a)
-> (Sem r a
    -> Sem
         (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
            : Lock : r)
         a)
-> Sem r a
-> Sem
     (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Lock : r) a
-> Sem
     (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     a
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem (Lock : r) a
 -> Sem
      (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
         : Lock : r)
      a)
-> (Sem r a -> Sem (Lock : r) a)
-> Sem r a
-> Sem
     (AtomicState (Map WatchedVariable (Object, Object -> Handler r ()))
        : Lock : r)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r a -> Sem (Lock : r) a
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise

-- |Interpret 'VariableWatcher' with 'watchVariables', but eliminate the effect from the stack.
interpretVariableWatcher ::
  Members [Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r =>
  Map WatchedVariable (Object -> Handler (VariableWatcher !! Report : r) ()) ->
  InterpreterFor (VariableWatcher !! Report) r
interpretVariableWatcher :: forall mres (r :: [Effect]).
Members
  '[Rpc !! RpcError, Resource, Mask mres, Race, Embed IO] r =>
Map
  WatchedVariable
  (Object -> Handler ((VariableWatcher !! Report) : r) ())
-> InterpreterFor (VariableWatcher !! Report) r
interpretVariableWatcher Map
  WatchedVariable
  (Object -> Handler ((VariableWatcher !! Report) : r) ())
vars =
  Sem ((VariableWatcher !! Report) : r) a -> Sem r a
forall (r :: [Effect]).
InterpreterFor (VariableWatcher !! Report) r
interpretVariableWatcherNull (Sem ((VariableWatcher !! Report) : r) a -> Sem r a)
-> (Sem ((VariableWatcher !! Report) : r) a
    -> Sem ((VariableWatcher !! Report) : r) a)
-> Sem ((VariableWatcher !! Report) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  WatchedVariable
  (Object -> Handler ((VariableWatcher !! Report) : r) ())
-> Sem ((VariableWatcher !! Report) : r) a
-> Sem ((VariableWatcher !! Report) : r) a
forall mres (r :: [Effect]) a.
Members
  '[VariableWatcher !! Report, Rpc !! RpcError, Resource, Mask mres,
    Race, Embed IO]
  r =>
Map WatchedVariable (Object -> Handler r ()) -> Sem r a -> Sem r a
watchVariables Map
  WatchedVariable
  (Object -> Handler ((VariableWatcher !! Report) : r) ())
vars