module Chiasma.Native.Process where import qualified Data.ByteString.Lazy as Lazy (ByteString) import Data.ByteString.Lazy.Internal (unpackChars) import qualified Data.Text as Text (intercalate, lines, pack, unwords) import System.Exit (ExitCode(ExitSuccess)) import System.Process.Typed (ProcessConfig, byteStringInput, proc, readProcessStdout, setStdin) import Chiasma.Codec.Decode (TmuxDecodeError) import Chiasma.Data.Cmd (Cmd(..), CmdArgs(..), CmdName(..), Cmds(..)) import Chiasma.Data.TmuxError (TmuxError) import qualified Chiasma.Data.TmuxError as TmuxError ( TmuxError(OutputParsingFailed, NoOutput, ProcessFailed, DecodingFailed), ) import Chiasma.Native.Parse (resultLines) cmdBytes :: [Text] -> Lazy.ByteString cmdBytes :: [Text] -> ByteString cmdBytes [Text] cmds = Text -> ByteString forall a b. ConvertUtf8 a b => a -> b encodeUtf8 (Text -> ByteString) -> Text -> ByteString forall a b. (a -> b) -> a -> b $ Text -> [Text] -> Text Text.intercalate Text "\n" ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ [Text] -> [Text] forall a. [a] -> [a] reverse ([Text] -> [Text]) -> [Text] -> [Text] forall a b. (a -> b) -> a -> b $ Text "" Text -> [Text] -> [Text] forall a. a -> [a] -> [a] : [Text] cmds socketArg :: Maybe FilePath -> [Text] socketArg :: Maybe FilePath -> [Text] socketArg (Just FilePath socket) = [Item [Text] "-S", FilePath -> Text forall a. ToText a => a -> Text toText FilePath socket] socketArg Maybe FilePath Nothing = [] tmuxProcessConfig :: Maybe FilePath -> [Text] -> ProcessConfig () () () tmuxProcessConfig :: Maybe FilePath -> [Text] -> ProcessConfig () () () tmuxProcessConfig Maybe FilePath socket [Text] cmds = [FilePath] -> ProcessConfig () () () cons [FilePath] args where cons :: [FilePath] -> ProcessConfig () () () cons = StreamSpec 'STInput () -> ProcessConfig () () () -> ProcessConfig () () () forall stdin stdin0 stdout stderr. StreamSpec 'STInput stdin -> ProcessConfig stdin0 stdout stderr -> ProcessConfig stdin stdout stderr setStdin (ByteString -> StreamSpec 'STInput () byteStringInput (ByteString -> StreamSpec 'STInput ()) -> ByteString -> StreamSpec 'STInput () forall a b. (a -> b) -> a -> b $ [Text] -> ByteString cmdBytes [Text] cmds) (ProcessConfig () () () -> ProcessConfig () () ()) -> ([FilePath] -> ProcessConfig () () ()) -> [FilePath] -> ProcessConfig () () () 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 socket [Text] -> [Text] -> [Text] forall a. Semigroup a => a -> a -> a <> [Item [Text] "-C", Item [Text] "attach"]) handleProcessOutput :: Cmds -> ExitCode -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError [a] handleProcessOutput :: Cmds -> ExitCode -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError [a] handleProcessOutput Cmds cmds ExitCode ExitSuccess Text -> Either TmuxDecodeError a decode Text out = do [[Text]] outputs <- (ParseError -> TmuxError) -> Either ParseError [[Text]] -> Either TmuxError [[Text]] forall a c b. (a -> c) -> Either a b -> Either c b mapLeft (Cmds -> [Text] -> ParseError -> TmuxError TmuxError.OutputParsingFailed Cmds cmds (Text -> [Text] Text.lines Text out)) (Either ParseError [[Text]] -> Either TmuxError [[Text]]) -> Either ParseError [[Text]] -> Either TmuxError [[Text]] forall a b. (a -> b) -> a -> b $ Text -> Either ParseError [[Text]] resultLines Text out case [[Text]] -> [[Text]] forall a. [a] -> [a] reverse [[Text]] outputs of [Text] output : [[Text]] _ -> (Text -> Either TmuxError a) -> [Text] -> Either TmuxError [a] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse Text -> Either TmuxError a decode' [Text] output [[Text]] _ -> TmuxError -> Either TmuxError [a] forall a b. a -> Either a b Left (TmuxError -> Either TmuxError [a]) -> TmuxError -> Either TmuxError [a] forall a b. (a -> b) -> a -> b $ Cmds -> TmuxError TmuxError.NoOutput Cmds cmds where decode' :: Text -> Either TmuxError a decode' = (TmuxDecodeError -> TmuxError) -> Either TmuxDecodeError a -> Either TmuxError a forall a c b. (a -> c) -> Either a b -> Either c b mapLeft (Cmds -> Text -> TmuxDecodeError -> TmuxError TmuxError.DecodingFailed Cmds cmds Text out) (Either TmuxDecodeError a -> Either TmuxError a) -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError a forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Either TmuxDecodeError a decode handleProcessOutput Cmds cmds ExitCode _ Text -> Either TmuxDecodeError a _ Text out = TmuxError -> Either TmuxError [a] forall a b. a -> Either a b Left (TmuxError -> Either TmuxError [a]) -> TmuxError -> Either TmuxError [a] forall a b. (a -> b) -> a -> b $ Cmds -> Text -> TmuxError TmuxError.ProcessFailed Cmds cmds Text out formatCmd :: Cmd -> Text formatCmd :: Cmd -> Text formatCmd (Cmd (CmdName Text name) (CmdArgs [Text] args)) = [Text] -> Text Text.unwords ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ Text name Text -> [Text] -> [Text] forall a. a -> [a] -> [a] : [Text] args nativeTmuxProcess :: (MonadIO m, MonadDeepError e TmuxError m) => Maybe FilePath -> (Text -> Either TmuxDecodeError a) -> Cmds -> m [a] nativeTmuxProcess :: Maybe FilePath -> (Text -> Either TmuxDecodeError a) -> Cmds -> m [a] nativeTmuxProcess Maybe FilePath socket Text -> Either TmuxDecodeError a decode cmds :: Cmds cmds@(Cmds [Cmd] cmds') = do let cmdLines :: [Text] cmdLines = (Cmd -> Text) -> [Cmd] -> [Text] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Cmd -> Text formatCmd [Cmd] cmds' (ExitCode code, ByteString out) <- ProcessConfig () () () -> m (ExitCode, ByteString) forall (m :: * -> *) stdin stdoutIgnored stderr. MonadIO m => ProcessConfig stdin stdoutIgnored stderr -> m (ExitCode, ByteString) readProcessStdout (ProcessConfig () () () -> m (ExitCode, ByteString)) -> ProcessConfig () () () -> m (ExitCode, ByteString) forall a b. (a -> b) -> a -> b $ Maybe FilePath -> [Text] -> ProcessConfig () () () tmuxProcessConfig Maybe FilePath socket [Text] cmdLines Either TmuxError [a] -> m [a] forall e e' (m :: * -> *) a. MonadDeepError e e' m => Either e' a -> m a hoistEither (Either TmuxError [a] -> m [a]) -> Either TmuxError [a] -> m [a] forall a b. (a -> b) -> a -> b $ Cmds -> ExitCode -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError [a] forall a. Cmds -> ExitCode -> (Text -> Either TmuxDecodeError a) -> Text -> Either TmuxError [a] handleProcessOutput Cmds cmds ExitCode code Text -> Either TmuxDecodeError a decode (Text -> Either TmuxError [a]) -> Text -> Either TmuxError [a] forall a b. (a -> b) -> a -> b $ FilePath -> Text Text.pack (FilePath -> Text) -> FilePath -> Text forall a b. (a -> b) -> a -> b $ ByteString -> FilePath unpackChars ByteString out