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