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

import Exon (exon)
import qualified Log
import Path (Abs, File, Path, toFilePath)
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)
import Polysemy.Process (interpretProcessByteStringNative)
import Polysemy.Process.Data.ProcessError (ProcessError)

-- |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, 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
  Bool
-> Int
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped () (Process ByteString ByteString ByteString)
      !! ProcessError)
     r
forall (r :: EffectRow).
Members '[Resource, Race, Async, Embed IO] r =>
Bool
-> Int
-> ProcessConfig () () ()
-> InterpreterFor
     (Scoped () (Process ByteString ByteString ByteString)
      !! ProcessError)
     r
interpretProcessByteStringNative Bool
True Int
64 (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}|]