-- |Functions for simulating user input in tests.
module Ribosome.Api.Input where

import Conc (withAsync_)
import qualified Polysemy.Time as Time
import Time (MilliSeconds, NanoSeconds, convert)

import Ribosome.Host.Api.Effect (nvimInput, nvimReplaceTermcodes, nvimFeedkeys)
import Ribosome.Host.Effect.Rpc (Rpc)

-- |Send a list of character sequences as user input to Neovim with an optional wait interval.
--
-- Uses @nvim_input@.
syntheticInput ::
  Members [Rpc, Time t d] r =>
  Maybe NanoSeconds ->
  [Text] ->
  Sem r ()
syntheticInput :: forall t d (r :: EffectRow).
Members '[Rpc, Time t d] r =>
Maybe NanoSeconds -> [Text] -> Sem r ()
syntheticInput Maybe NanoSeconds
interval =
  (Text -> Sem r Int) -> [Text] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ Text
c ->
    (NanoSeconds -> Sem r ()) -> Maybe NanoSeconds -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NanoSeconds -> Sem r ()
forall t d u (r :: EffectRow).
(TimeUnit u, Member (Time t d) r) =>
u -> Sem r ()
Time.sleep Maybe NanoSeconds
interval Sem r () -> Sem r Int -> Sem r Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Sem r Int
forall (r :: EffectRow). Member Rpc r => Text -> Sem r Int
nvimInput Text
c

-- |Send a sequence of keys using @nvim_feedkeys@ after replacing terminal codes.
feedKey ::
  Member Rpc r =>
  Text ->
  Sem r ()
feedKey :: forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
feedKey Text
k = do
  Text
key <- Text -> Bool -> Bool -> Bool -> Sem r Text
forall (r :: EffectRow).
Member Rpc r =>
Text -> Bool -> Bool -> Bool -> Sem r Text
nvimReplaceTermcodes Text
k Bool
True Bool
False Bool
True
  Text -> Text -> Bool -> Sem r ()
forall (r :: EffectRow).
Member Rpc r =>
Text -> Text -> Bool -> Sem r ()
nvimFeedkeys Text
key Text
"mt" Bool
False

-- |Send a list of character sequences as user input to Neovim with an optional wait interval.
--
-- Uses @nvim_feedkeys@.
syntheticInputFk ::
  Members [Rpc, Time t d] r =>
  Maybe NanoSeconds ->
  [Text] ->
  Sem r ()
syntheticInputFk :: forall t d (r :: EffectRow).
Members '[Rpc, Time t d] r =>
Maybe NanoSeconds -> [Text] -> Sem r ()
syntheticInputFk Maybe NanoSeconds
interval =
  (Text -> Sem r ()) -> [Text] -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ Text
c ->
    (NanoSeconds -> Sem r ()) -> Maybe NanoSeconds -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ NanoSeconds -> Sem r ()
forall t d u (r :: EffectRow).
(TimeUnit u, Member (Time t d) r) =>
u -> Sem r ()
Time.sleep Maybe NanoSeconds
interval Sem r () -> Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Sem r ()
forall (r :: EffectRow). Member Rpc r => Text -> Sem r ()
feedKey Text
c

-- |Run an action after forking a thread that sends user input to Neovim. 
withInput ::
  Members [Rpc, Resource, Race, Async, Time t d] r =>
  Maybe MilliSeconds ->
  Maybe MilliSeconds ->
  [Text] ->
  Sem r a ->
  Sem r a
withInput :: forall t d (r :: EffectRow) a.
Members '[Rpc, Resource, Race, Async, Time t d] r =>
Maybe MilliSeconds
-> Maybe MilliSeconds -> [Text] -> Sem r a -> Sem r a
withInput Maybe MilliSeconds
delay Maybe MilliSeconds
interval [Text]
chrs =
  Sem r () -> Sem r a -> Sem r a
forall (r :: EffectRow) b a.
Members '[Resource, Race, Async] r =>
Sem r b -> Sem r a -> Sem r a
withAsync_ ((MilliSeconds -> Sem r ()) -> Maybe MilliSeconds -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ MilliSeconds -> Sem r ()
forall t d u (r :: EffectRow).
(TimeUnit u, Member (Time t d) r) =>
u -> Sem r ()
Time.sleep Maybe MilliSeconds
delay Sem r () -> Sem r () -> Sem r ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe NanoSeconds -> [Text] -> Sem r ()
forall t d (r :: EffectRow).
Members '[Rpc, Time t d] r =>
Maybe NanoSeconds -> [Text] -> Sem r ()
syntheticInput (MilliSeconds -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (MilliSeconds -> NanoSeconds)
-> Maybe MilliSeconds -> Maybe NanoSeconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MilliSeconds
interval) [Text]
chrs)