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

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

import qualified Helic.Data.TmuxConfig as TmuxConfig
import Helic.Data.TmuxConfig (TmuxConfig)
import Helic.Effect.Agent (Agent (Update), AgentTmux)
import Helic.Interpreter (interpreting)
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 [Item [FilePath]
"load-buffer", Item [FilePath]
"-"]
  where
    cmd :: FilePath
cmd =
      FilePath
-> (Path Abs File -> FilePath) -> Maybe (Path Abs File) -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"tmux" Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Maybe (Path Abs File)
exe

-- |Consult the config as to whether tmux should be used, defaulting to true.
enableTmux ::
  Member (Reader TmuxConfig) r =>
  Sem r Bool
enableTmux :: Sem r Bool
enableTmux =
  Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Sem r (Maybe Bool) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TmuxConfig -> Maybe Bool) -> Sem r (Maybe Bool)
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks TmuxConfig -> Maybe Bool
TmuxConfig.enable

-- |Interpret 'Agent' using a tmux server as the target.
interpretAgentTmux ::
  Members [Reader TmuxConfig, Log, Async, Race, Resource, ChronosTime, Embed IO] r =>
  InterpreterFor (Tagged AgentTmux Agent) r
interpretAgentTmux :: InterpreterFor (Tagged AgentTmux Agent) r
interpretAgentTmux Sem (Tagged AgentTmux Agent : r) a
sem = do
  Maybe (Path Abs File)
exe <- (TmuxConfig -> Maybe (Path Abs File))
-> Sem r (Maybe (Path Abs File))
forall i j (r :: EffectRow).
Member (Reader i) r =>
(i -> j) -> Sem r j
asks TmuxConfig -> Maybe (Path Abs File)
TmuxConfig.exe
  ProcessOptions
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped () (Process ByteString ByteString ByteString)
      !! ProcessError)
     r
forall (r :: EffectRow).
Members '[Resource, Race, Async, Embed IO] r =>
ProcessOptions
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped () (Process ByteString ByteString ByteString)
      !! ProcessError)
     r
interpretProcessByteStringNative ProcessOptions
forall a. Default a => a
def { $sel:kill:ProcessOptions :: ProcessKill
kill = NanoSeconds -> ProcessKill
KillAfter (MilliSeconds -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (Int64 -> MilliSeconds
MilliSeconds Int64
500)) } (Maybe (Path Abs File) -> ProcessConfig () () ()
tmuxProc Maybe (Path Abs File)
exe) (Sem
   ((Scoped () (Process ByteString ByteString ByteString)
     !! ProcessError)
      : r)
   a
 -> Sem r a)
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
    Sem
  (Agent
     : (Scoped () (Process ByteString ByteString ByteString)
        !! ProcessError)
     : r)
  a
-> (forall (r0 :: EffectRow) x.
    Agent (Sem r0) x
    -> Sem
         ((Scoped () (Process ByteString ByteString ByteString)
           !! ProcessError)
            : r)
         x)
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
Sem (e : r) a
-> (forall (r0 :: EffectRow) x. e (Sem r0) x -> Sem r x) -> Sem r a
interpreting (Sem (Agent : r) a
-> Sem
     (Agent
        : (Scoped () (Process ByteString ByteString ByteString)
           !! ProcessError)
        : r)
     a
forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Tagged AgentTmux Agent : r) a -> Sem (Agent : r) a
forall k1 (k2 :: k1) (e :: Effect) (r :: EffectRow) a.
Sem (Tagged k2 e : r) a -> Sem (e : r) a
untag Sem (Tagged AgentTmux Agent : r) a
sem)) \case
      Update Event
event ->
        Sem
  ((Scoped () (Process ByteString ByteString ByteString)
    !! ProcessError)
     : r)
  Bool
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     ()
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM Sem
  ((Scoped () (Process ByteString ByteString ByteString)
    !! ProcessError)
     : r)
  Bool
forall (r :: EffectRow). Member (Reader TmuxConfig) r => Sem r Bool
enableTmux do
          Event
-> Sem
     (Scoped () (Process ByteString ByteString ByteString)
        : (Scoped () (Process ByteString ByteString ByteString)
           !! ProcessError)
        : r)
     ()
forall o e resource (r :: EffectRow).
Members '[Scoped resource (Process ByteString o e), Log] r =>
Event -> Sem r ()
sendToTmux Event
event Sem
  (Scoped () (Process ByteString ByteString ByteString)
     : (Scoped () (Process ByteString ByteString ByteString)
        !! ProcessError)
     : r)
  ()
-> (ProcessError
    -> Sem
         ((Scoped () (Process ByteString ByteString ByteString)
           !! ProcessError)
            : r)
         ())
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     ()
forall err (eff :: Effect) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! \ (ProcessError
e :: ProcessError) ->
            Text
-> Sem
     ((Scoped () (Process ByteString ByteString ByteString)
       !! ProcessError)
        : r)
     ()
forall (r :: EffectRow).
(HasCallStack, Member Log r) =>
Text -> Sem r ()
Log.error [exon|Sending to tmux: #{show e}|]