-- |Agent Interpreter for Tmux, Internal
module Helic.Interpreter.AgentTmux where

import Exon (exon)
import qualified Log
import Path (Abs, File, Path, toFilePath)
import Polysemy.Process (Process, ProcessKill (KillAfter), interpretProcessByteString, interpretProcessNative_)
import Polysemy.Process.Data.ProcessError (ProcessError)
import Polysemy.Process.Data.ProcessOptions (ProcessOptions (kill))
import qualified System.Process.Typed as Process
import System.Process.Typed (ProcessConfig)
import Time (MilliSeconds (MilliSeconds), convert)

import qualified Helic.Data.TmuxConfig as TmuxConfig
import Helic.Data.TmuxConfig (TmuxConfig)
import Helic.Effect.Agent (Agent (Update), AgentTmux)
import Helic.Interpreter.Agent (interpretAgentIf)
import Helic.Tmux (sendToTmux)

-- |Process definition for running `tmux load-buffer -`.
tmuxProc ::
  Maybe (Path Abs File) ->
  ProcessConfig () () ()
tmuxProc :: Maybe (Path Abs File) -> ProcessConfig () () ()
tmuxProc Maybe (Path Abs File)
exe =
  FilePath -> [FilePath] -> ProcessConfig () () ()
Process.proc FilePath
cmd [FilePath
"load-buffer", FilePath
"-"]
  where
    cmd :: FilePath
cmd =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"tmux" forall b t. Path b t -> FilePath
toFilePath Maybe (Path Abs File)
exe

-- |Handle 'Agent' using a tmux server as the target.
handleAgentTmux ::
  Members [Scoped_ (Process ByteString o) !! ProcessError, Log] r =>
  Agent m a ->
  Sem r a
handleAgentTmux :: forall o (r :: EffectRow) (m :: * -> *) a.
Members '[Scoped_ (Process ByteString o) !! ProcessError, Log] r =>
Agent m a -> Sem r a
handleAgentTmux (Update Event
event) =
  forall o (r :: EffectRow).
Members '[Scoped_ (Process ByteString o), Log] r =>
Event -> Sem r ()
sendToTmux @_ @(_ _ : _) Event
event forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ (ProcessError
e :: ProcessError) ->
    forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Sending to tmux: #{show e}|]

-- |Interpret 'Agent' using a tmux server as the target.
interpretAgentTmux ::
  Members [Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>
  InterpreterFor Agent r
interpretAgentTmux :: forall (r :: EffectRow).
Members
  '[Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>
InterpreterFor Agent r
interpretAgentTmux Sem (Agent : r) a
sem = do
  TmuxConfig
conf <- forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
  forall (r :: EffectRow).
InterpretersFor (ProcessIO ByteString ByteString) r
interpretProcessByteString forall a b. (a -> b) -> a -> b
$
    forall i o (r :: EffectRow).
(Members (ProcessIO i o) r,
 Members '[Resource, Race, Async, Embed IO] r) =>
ProcessOptions
-> ProcessConfig () () ()
-> InterpreterFor (Scoped_ (Process i o) !! ProcessError) r
interpretProcessNative_ ProcessOptions
options (Maybe (Path Abs File) -> ProcessConfig () () ()
tmuxProc TmuxConfig
conf.exe) forall a b. (a -> b) -> a -> b
$
    forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret forall o (r :: EffectRow) (m :: * -> *) a.
Members '[Scoped_ (Process ByteString o) !! ProcessError, Log] r =>
Agent m a -> Sem r a
handleAgentTmux forall a b. (a -> b) -> a -> b
$
    forall (index :: Nat) (inserted :: EffectRow) (head :: EffectRow)
       (oldTail :: EffectRow) (tail :: EffectRow) (old :: EffectRow)
       (full :: EffectRow) a.
(ListOfLength index head, WhenStuck index InsertAtUnprovidedIndex,
 old ~ Append head oldTail, tail ~ Append inserted oldTail,
 full ~ Append head tail,
 InsertAtIndex index head tail oldTail full inserted) =>
Sem old a -> Sem full a
insertAt @1 Sem (Agent : r) a
sem
  where
    options :: ProcessOptions
options = forall a. Default a => a
def { $sel:kill:ProcessOptions :: ProcessKill
kill = NanoSeconds -> ProcessKill
KillAfter (forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (Int64 -> MilliSeconds
MilliSeconds Int64
500)) }

-- | Interpret 'Agent' for tmux if it is enabled by the configuration.
interpretAgentTmuxIfEnabled ::
  Members [Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>
  InterpreterFor (Agent @@ AgentTmux) r
interpretAgentTmuxIfEnabled :: forall (r :: EffectRow).
Members
  '[Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>
InterpreterFor (Agent @@ AgentTmux) r
interpretAgentTmuxIfEnabled =
  forall {k} conf (r :: EffectRow) (id :: k).
(HasField "enable" conf (Maybe Bool), Member (Reader conf) r) =>
InterpreterFor Agent r -> InterpreterFor (Agent @@ id) r
interpretAgentIf forall (r :: EffectRow).
Members
  '[Reader TmuxConfig, Log, Resource, Race, Async, Embed IO] r =>
InterpreterFor Agent r
interpretAgentTmux