{-# LANGUAGE UndecidableInstances #-} module Chiasma.Native.Api where import Chiasma.Data.TmuxError (TmuxError) import Conduit (ConduitT, Flush, mapC, (.|)) import Control.Monad.Catch (MonadMask) import qualified Control.Monad.Catch as Catch (bracket) import Data.Conduit.Process.Typed (createSource) import qualified Data.Text as Text (unwords) import System.Process.Typed ( Process, ProcessConfig, getStdin, getStdout, proc, setStdin, setStdout, startProcess, stopProcess, ) import Text.ParserCombinators.Parsec () import Chiasma.Api.Class (TmuxApi(..)) import Chiasma.Data.Cmd (Cmd(..), CmdArgs(..), CmdName(..)) import Chiasma.Data.Conduit (createSinkFlush) import Chiasma.Native.Process (nativeTmuxProcess, socketArg) import Chiasma.Native.StreamParse (parseConduit) newtype TmuxNative = TmuxNative { TmuxNative -> Maybe FilePath tmuxServerSocket :: Maybe FilePath } deriving Int -> TmuxNative -> ShowS [TmuxNative] -> ShowS TmuxNative -> FilePath (Int -> TmuxNative -> ShowS) -> (TmuxNative -> FilePath) -> ([TmuxNative] -> ShowS) -> Show TmuxNative forall a. (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a showList :: [TmuxNative] -> ShowS $cshowList :: [TmuxNative] -> ShowS show :: TmuxNative -> FilePath $cshow :: TmuxNative -> FilePath showsPrec :: Int -> TmuxNative -> ShowS $cshowsPrec :: Int -> TmuxNative -> ShowS Show formatCmd :: Cmd -> ByteString formatCmd :: Cmd -> ByteString formatCmd (Cmd (CmdName Text name) (CmdArgs [Text] args)) = Text -> ByteString forall a b. ConvertUtf8 a b => a -> b encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . [Text] -> Text Text.unwords ([Text] -> ByteString) -> [Text] -> ByteString forall a b. (a -> b) -> a -> b $ Text name Text -> [Text] -> [Text] forall a. a -> [a] -> [a] : [Text] args [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] "\n"] tmuxProcessConfig :: MonadIO m => Maybe FilePath -> ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () tmuxProcessConfig :: Maybe FilePath -> ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () tmuxProcessConfig Maybe FilePath sock = [FilePath] -> ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () forall o i. [FilePath] -> ProcessConfig (ConduitT (Flush ByteString) o m ()) (ConduitM i ByteString m ()) () cons [FilePath] args where cons :: [FilePath] -> ProcessConfig (ConduitT (Flush ByteString) o m ()) (ConduitM i ByteString m ()) () cons = StreamSpec 'STInput (ConduitT (Flush ByteString) o m ()) -> ProcessConfig () (ConduitM i ByteString m ()) () -> ProcessConfig (ConduitT (Flush ByteString) o m ()) (ConduitM i ByteString m ()) () forall stdin stdin0 stdout stderr. StreamSpec 'STInput stdin -> ProcessConfig stdin0 stdout stderr -> ProcessConfig stdin stdout stderr setStdin StreamSpec 'STInput (ConduitT (Flush ByteString) o m ()) forall (m :: * -> *) o. MonadIO m => StreamSpec 'STInput (ConduitT (Flush ByteString) o m ()) createSinkFlush (ProcessConfig () (ConduitM i ByteString m ()) () -> ProcessConfig (ConduitT (Flush ByteString) o m ()) (ConduitM i ByteString m ()) ()) -> ([FilePath] -> ProcessConfig () (ConduitM i ByteString m ()) ()) -> [FilePath] -> ProcessConfig (ConduitT (Flush ByteString) o m ()) (ConduitM i ByteString m ()) () forall b c a. (b -> c) -> (a -> b) -> a -> c . StreamSpec 'STOutput (ConduitM i ByteString m ()) -> ProcessConfig () () () -> ProcessConfig () (ConduitM i ByteString m ()) () forall stdout stdin stdout0 stderr. StreamSpec 'STOutput stdout -> ProcessConfig stdin stdout0 stderr -> ProcessConfig stdin stdout stderr setStdout StreamSpec 'STOutput (ConduitM i ByteString m ()) forall (m :: * -> *) i. MonadIO m => StreamSpec 'STOutput (ConduitM i ByteString m ()) createSource (ProcessConfig () () () -> ProcessConfig () (ConduitM i ByteString m ()) ()) -> ([FilePath] -> ProcessConfig () () ()) -> [FilePath] -> ProcessConfig () (ConduitM i ByteString m ()) () forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> [FilePath] -> ProcessConfig () () () proc FilePath "tmux" args :: [FilePath] args = Text -> FilePath forall a. ToString a => a -> FilePath toString (Text -> FilePath) -> [Text] -> [FilePath] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Maybe FilePath -> [Text] socketArg Maybe FilePath sock [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [Item [Text] "-C", Item [Text] "attach"]) withProcess :: (MonadIO m, MonadMask m) => ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> m a) -> m a withProcess :: ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> m a) -> m a withProcess ProcessConfig stdin stdout stderr config = m (Process stdin stdout stderr) -> (Process stdin stdout stderr -> m ()) -> (Process stdin stdout stderr -> m a) -> m a forall (m :: * -> *) a c b. MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b Catch.bracket (ProcessConfig stdin stdout stderr -> m (Process stdin stdout stderr) forall (m :: * -> *) stdin stdout stderr. MonadIO m => ProcessConfig stdin stdout stderr -> m (Process stdin stdout stderr) startProcess ProcessConfig stdin stdout stderr config) Process stdin stdout stderr -> m () forall (m :: * -> *) stdin stdout stderr. MonadIO m => Process stdin stdout stderr -> m () stopProcess instance (MonadIO m, MonadDeepError e TmuxError m, MonadMask m) => TmuxApi m TmuxNative where runCommands :: TmuxNative -> (Text -> Either TmuxDecodeError b) -> Cmds -> m [b] runCommands (TmuxNative Maybe FilePath socket) = Maybe FilePath -> (Text -> Either TmuxDecodeError b) -> Cmds -> m [b] forall (m :: * -> *) e a. (MonadIO m, MonadDeepError e TmuxError m) => Maybe FilePath -> (Text -> Either TmuxDecodeError a) -> Cmds -> m [a] nativeTmuxProcess Maybe FilePath socket withTmux :: TmuxNative -> (ConduitT (Flush Cmd) Void m () -> ConduitT () TmuxOutputBlock m () -> m b) -> m b withTmux (TmuxNative Maybe FilePath socket) ConduitT (Flush Cmd) Void m () -> ConduitT () TmuxOutputBlock m () -> m b f = ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> (Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> m b) -> m b forall (m :: * -> *) stdin stdout stderr a. (MonadIO m, MonadMask m) => ProcessConfig stdin stdout stderr -> (Process stdin stdout stderr -> m a) -> m a withProcess (Maybe FilePath -> ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () forall (m :: * -> *). MonadIO m => Maybe FilePath -> ProcessConfig (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () tmuxProcessConfig Maybe FilePath socket) Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> m b handler where handler :: Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> m b handler Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () prc = let stdin' :: ConduitT (Flush Cmd) Void m () stdin' = (Flush Cmd -> Flush ByteString) -> ConduitT (Flush Cmd) (Flush ByteString) m () forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m () mapC ((Cmd -> ByteString) -> Flush Cmd -> Flush ByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Cmd -> ByteString formatCmd) ConduitT (Flush Cmd) (Flush ByteString) m () -> ConduitT (Flush ByteString) Void m () -> ConduitT (Flush Cmd) Void m () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> ConduitT (Flush ByteString) Void m () forall stdin stdout stderr. Process stdin stdout stderr -> stdin getStdin Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () prc stdout' :: ConduitT () TmuxOutputBlock m () stdout' = Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () -> ConduitT () ByteString m () forall stdin stdout stderr. Process stdin stdout stderr -> stdout getStdout Process (ConduitT (Flush ByteString) Void m ()) (ConduitT () ByteString m ()) () prc ConduitT () ByteString m () -> ConduitM ByteString TmuxOutputBlock m () -> ConduitT () TmuxOutputBlock m () forall (m :: * -> *) a b c r. Monad m => ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r .| ConduitM ByteString TmuxOutputBlock m () forall (m :: * -> *). MonadThrow m => ConduitT ByteString TmuxOutputBlock m () parseConduit in ConduitT (Flush Cmd) Void m () -> ConduitT () TmuxOutputBlock m () -> m b f ConduitT (Flush Cmd) Void m () stdin' ConduitT () TmuxOutputBlock m () stdout'