2020-04-01 22:06:00 -04:00
|
|
|
-- | Functions for formatting and spawning shell commands
|
2022-12-29 13:36:26 -05:00
|
|
|
--
|
|
|
|
-- TLDR: spawning a "command" in xmonad is complicated for weird reasons, and
|
|
|
|
-- this solution is the most sane (for me) given the constraints of the xmonad
|
|
|
|
-- codebase.
|
|
|
|
--
|
|
|
|
-- 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 that 'System.Process.waitForProcess' (and similar)
|
|
|
|
-- will not work since these call wait() on the child process, which will fail
|
|
|
|
-- because the child has already been cleared and thus there is nothing on which
|
|
|
|
-- to wait. By extension this also means we don't have access to a child's exit
|
|
|
|
-- code.
|
|
|
|
--
|
|
|
|
-- 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
|
|
|
|
-- 3) call setsid()
|
|
|
|
-- 4) start new thing with exec()
|
|
|
|
--
|
|
|
|
-- In practice, I'm guessing the main reason for 2 and 3 is so that child
|
|
|
|
-- processes don't inherit the weird SIGCHLD behavior of xmonad itself. The
|
|
|
|
-- setsid thing is one way to guarantee that killing the child thread will also
|
|
|
|
-- kill its children (if any). Note that this obviously will not block since
|
|
|
|
-- we are calling fork() without wait() (which would throw an error anyways).
|
|
|
|
--
|
|
|
|
-- What if I actually want the 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 (since it actually will be blocking). NOTE: I
|
|
|
|
-- shouldn't use this to replace the existing functions in xmonad since
|
|
|
|
-- 'spawning' a new process in a non-blocking manner with a higher-level API
|
|
|
|
-- will produce lots of Haskell objects that need to be cleaned, and it will be
|
|
|
|
-- hard (perhaps impossible) to keep track and deal with these after spawning.
|
|
|
|
--
|
|
|
|
-- This works, albeit with the cost of using almost every process API in Haskell.
|
|
|
|
--
|
|
|
|
-- Briefly:
|
|
|
|
-- 1) 'System.Process.Posix' (where xmonad lives)
|
|
|
|
-- 2) 'System.Process' (wraps 1)
|
|
|
|
-- 2) 'System.Process.Typed' (wraps 2, which I prefer for getting exit codes)
|
|
|
|
-- 3) 'RIO.Process' (wraps 3, which I prefer at the app level)
|
|
|
|
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2020-04-01 22:06:00 -04:00
|
|
|
|
2020-04-01 20:17:47 -04:00
|
|
|
module XMonad.Internal.Shell
|
2021-11-07 13:35:08 -05:00
|
|
|
( fmtCmd
|
2020-04-01 20:17:47 -04:00
|
|
|
, spawnCmd
|
2022-12-29 00:06:55 -05:00
|
|
|
, spawn
|
2022-12-29 14:49:06 -05:00
|
|
|
, spawnPipe
|
2021-06-17 01:17:59 -04:00
|
|
|
, doubleQuote
|
|
|
|
, singleQuote
|
2021-06-19 00:17:47 -04:00
|
|
|
, skip
|
2022-12-29 12:01:40 -05:00
|
|
|
, runProcess
|
|
|
|
, proc
|
|
|
|
, shell
|
2020-04-01 20:17:47 -04:00
|
|
|
, (#!&&)
|
|
|
|
, (#!||)
|
2021-06-20 01:01:36 -04:00
|
|
|
, (#!|)
|
2020-04-01 20:17:47 -04:00
|
|
|
, (#!>>)
|
|
|
|
) where
|
2020-03-18 12:17:39 -04:00
|
|
|
|
2022-12-29 00:06:55 -05:00
|
|
|
import RIO
|
2022-12-29 14:49:06 -05:00
|
|
|
import qualified RIO.Text as T
|
2022-12-26 14:45:49 -05:00
|
|
|
|
2022-12-29 14:49:06 -05:00
|
|
|
import qualified System.Process.Typed as P
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 14:49:06 -05:00
|
|
|
import qualified XMonad.Core as X
|
|
|
|
import qualified XMonad.Util.Run as XR
|
2020-03-28 18:38:38 -04:00
|
|
|
|
2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Opening subshell
|
2022-12-29 12:01:40 -05:00
|
|
|
-- https://github.com/xmonad/xmonad/issues/113
|
2020-03-18 12:17:39 -04:00
|
|
|
|
2022-12-29 00:06:55 -05:00
|
|
|
withDefaultSignalHandlers :: IO a -> IO a
|
|
|
|
withDefaultSignalHandlers =
|
|
|
|
bracket_ X.uninstallSignalHandlers X.installSignalHandlers
|
|
|
|
|
2022-12-29 12:01:40 -05:00
|
|
|
addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
|
|
|
|
addGroupSession = P.setCreateGroup True . P.setNewSession True
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 12:01:40 -05:00
|
|
|
runProcess :: P.ProcessConfig a b c -> IO ExitCode
|
|
|
|
runProcess = withDefaultSignalHandlers . P.runProcess
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 12:01:40 -05:00
|
|
|
shell :: T.Text -> P.ProcessConfig () () ()
|
|
|
|
shell = addGroupSession . P.shell . T.unpack
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 12:01:40 -05:00
|
|
|
proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
|
|
|
|
proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 12:01:40 -05:00
|
|
|
spawn :: MonadIO m => T.Text -> m ()
|
2022-12-29 14:49:06 -05:00
|
|
|
spawn = X.spawn . T.unpack
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 14:49:06 -05:00
|
|
|
-- spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
|
|
|
|
-- spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-29 14:49:06 -05:00
|
|
|
spawnPipe :: MonadIO m => T.Text -> m Handle
|
|
|
|
spawnPipe = XR.spawnPipe . T.unpack
|
2022-12-29 00:06:55 -05:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
|
2022-12-29 12:01:40 -05:00
|
|
|
spawnCmd cmd = spawn . fmtCmd cmd
|
2020-03-18 12:17:39 -04:00
|
|
|
|
2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Formatting commands
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
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]
|
2020-04-01 22:06:00 -04:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
(#!&&) :: T.Text -> T.Text -> T.Text
|
|
|
|
cmdA #!&& cmdB = op cmdA "&&" cmdB
|
2020-03-18 12:17:39 -04:00
|
|
|
|
|
|
|
infixr 0 #!&&
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
(#!|) :: T.Text -> T.Text -> T.Text
|
|
|
|
cmdA #!| cmdB = op cmdA "|" cmdB
|
2021-06-20 01:01:36 -04:00
|
|
|
|
|
|
|
infixr 0 #!|
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
(#!||) :: T.Text -> T.Text -> T.Text
|
|
|
|
cmdA #!|| cmdB = op cmdA "||" cmdB
|
2020-03-18 12:17:39 -04:00
|
|
|
|
|
|
|
infixr 0 #!||
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
(#!>>) :: T.Text -> T.Text -> T.Text
|
|
|
|
cmdA #!>> cmdB = op cmdA ";" cmdB
|
2020-03-18 12:17:39 -04:00
|
|
|
|
|
|
|
infixr 0 #!>>
|
2021-06-17 01:17:59 -04:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
doubleQuote :: T.Text -> T.Text
|
|
|
|
doubleQuote s = T.concat ["\"", s, "\""]
|
2021-06-17 01:17:59 -04:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
singleQuote :: T.Text -> T.Text
|
|
|
|
singleQuote s = T.concat ["'", s, "'"]
|
2021-11-07 13:35:08 -05:00
|
|
|
|
|
|
|
skip :: Monad m => m ()
|
|
|
|
skip = return ()
|