157 lines
5.1 KiB
Haskell
157 lines
5.1 KiB
Haskell
-- Functions for formatting and spawning shell commands
|
|
|
|
module XMonad.Internal.Shell
|
|
( fmtCmd
|
|
, spawnCmd
|
|
, spawn
|
|
, spawnPipe
|
|
, doubleQuote
|
|
, singleQuote
|
|
, skip
|
|
, runProcess
|
|
, proc
|
|
, shell
|
|
, (#!&&)
|
|
, (#!||)
|
|
, (#!|)
|
|
, (#!>>)
|
|
)
|
|
where
|
|
|
|
import RIO
|
|
import qualified RIO.Text as T
|
|
import qualified System.Process.Typed as P
|
|
import qualified XMonad.Core as X
|
|
import qualified XMonad.Util.Run as XR
|
|
|
|
-- | Fork a new process and wait for its exit code.
|
|
--
|
|
-- This function will work despite xmonad ignoring SIGCHLD.
|
|
--
|
|
-- A few facts about xmonad (and window managers in general):
|
|
-- 1) It is single-threaded (since X is single threaded)
|
|
-- 2) Because of (1), it ignores SIGCHLD, which means any subprocess started
|
|
-- by xmonad will instantly be reaped after spawning. This guarantees the
|
|
-- main thread running the WM will never be blocked.
|
|
--
|
|
-- In general, this means I can't wait for exit codes (since wait() doesn't
|
|
-- work) See https://github.com/xmonad/xmonad/issues/113.
|
|
--
|
|
-- If I want an exit code, The best solution (I can come up with), is to use
|
|
-- bracket to uninstall handlers, run process (with wait), and then reinstall
|
|
-- handlers. I can use this with a much higher-level interface which will make
|
|
-- things easier. This obviously means that if the process is running in the
|
|
-- main thread, it needs to be almost instantaneous. Note if using a high-level
|
|
-- API for this, the process needs to spawn, finish, and be reaped by the
|
|
-- xmonad process all while the signal handlers are 'disabled' (which limits
|
|
-- the functions I can use to those that call waitForProcess).
|
|
--
|
|
-- XMonad and contrib use their own method of spawning subprocesses using the
|
|
-- extremely low-level 'System.Process.Posix' API. See the code for
|
|
-- 'XMonad.Core.spawn' or 'XMonad.Util.Run.safeSpawn'. Specifically, the
|
|
-- sequence is (in terms of the low level Linux API):
|
|
-- 1) call fork()
|
|
-- 2) uninstall signal handlers (to allow wait() to work in subprocesses)
|
|
-- 3) call setsid() (so killing the child will kill its children, if any)
|
|
-- 4) start new thing with exec()
|
|
--
|
|
-- In contrast with high-level APIs like 'System.Process', this will leave no
|
|
-- trailing data structures to clean up, at the cost of being gross to look at
|
|
-- and possibly more error-prone.
|
|
runProcess :: MonadUnliftIO m => P.ProcessConfig a b c -> m ExitCode
|
|
runProcess = withDefaultSignalHandlers . P.runProcess
|
|
|
|
-- | Run an action without xmonad's signal handlers.
|
|
withDefaultSignalHandlers :: MonadUnliftIO m => m a -> m a
|
|
withDefaultSignalHandlers =
|
|
bracket_ X.uninstallSignalHandlers X.installSignalHandlers
|
|
|
|
-- | Set a child process to create a new group and session
|
|
addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
|
|
addGroupSession = P.setCreateGroup True . P.setNewSession True
|
|
|
|
-- | Create a 'ProcessConfig' for a shell command
|
|
shell :: T.Text -> P.ProcessConfig () () ()
|
|
shell = addGroupSession . P.shell . T.unpack
|
|
|
|
-- | Create a 'ProcessConfig' for a command with arguments
|
|
proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
|
|
proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
|
|
|
|
-- | Run 'XMonad.Core.spawn' with 'Text' input.
|
|
spawn :: MonadIO m => T.Text -> m ()
|
|
spawn = X.spawn . T.unpack
|
|
|
|
-- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
|
|
spawnPipe :: MonadUnliftIO m => T.Text -> m Handle
|
|
spawnPipe = liftIO . XR.spawnPipe . T.unpack
|
|
|
|
-- spawnPipeRW
|
|
-- :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
|
-- => T.Text
|
|
-- -> m Handle
|
|
-- spawnPipeRW x = do
|
|
-- (r, h) <- liftIO mkPipe
|
|
-- child r
|
|
-- liftIO $ closeFd r
|
|
-- return h
|
|
-- where
|
|
-- mkPipe = do
|
|
-- (r, w) <- createPipe
|
|
-- setFdOption w CloseOnExec True
|
|
-- h <- fdToHandle w
|
|
-- -- ASSUME we are using utf8 everywhere
|
|
-- hSetEncoding h utf8
|
|
-- hSetBuffering h LineBuffering
|
|
-- return (r, h)
|
|
-- child r = void $ withRunInIO $ \runIO -> do
|
|
-- X.xfork $ runIO $ do
|
|
-- void $ liftIO $ dupTo r stdInput
|
|
-- liftIO $ executeFile "/bin/sh" False ["-c", T.unpack x] Nothing
|
|
|
|
-- | Run 'XMonad.Core.spawn' with a command and arguments
|
|
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
|
|
spawnCmd cmd = spawn . fmtCmd cmd
|
|
|
|
-- | Format a command and list of arguments as 'Text'
|
|
fmtCmd :: FilePath -> [T.Text] -> T.Text
|
|
fmtCmd cmd args = T.unwords $ T.pack cmd : args
|
|
|
|
op :: T.Text -> T.Text -> T.Text -> T.Text
|
|
op a x b = T.unwords [a, x, b]
|
|
|
|
-- | Format two shell expressions separated by "&&"
|
|
(#!&&) :: T.Text -> T.Text -> T.Text
|
|
cmdA #!&& cmdB = op cmdA "&&" cmdB
|
|
|
|
infixr 0 #!&&
|
|
|
|
-- | Format two shell expressions separated by "|"
|
|
(#!|) :: T.Text -> T.Text -> T.Text
|
|
cmdA #!| cmdB = op cmdA "|" cmdB
|
|
|
|
infixr 0 #!|
|
|
|
|
-- | Format two shell expressions separated by "||"
|
|
(#!||) :: T.Text -> T.Text -> T.Text
|
|
cmdA #!|| cmdB = op cmdA "||" cmdB
|
|
|
|
infixr 0 #!||
|
|
|
|
-- | Format two shell expressions separated by ";"
|
|
(#!>>) :: T.Text -> T.Text -> T.Text
|
|
cmdA #!>> cmdB = op cmdA ";" cmdB
|
|
|
|
infixr 0 #!>>
|
|
|
|
-- | Wrap input in double quotes
|
|
doubleQuote :: T.Text -> T.Text
|
|
doubleQuote s = T.concat ["\"", s, "\""]
|
|
|
|
-- | Wrap input in single quotes
|
|
singleQuote :: T.Text -> T.Text
|
|
singleQuote s = T.concat ["'", s, "'"]
|
|
|
|
skip :: Monad m => m ()
|
|
skip = return ()
|