xmonad-config/lib/XMonad/Internal/Process.hs

--------------------------------------------------------------------------------
-- | Functions for managing processes

module XMonad.Internal.Process
  ( waitUntilExit
  -- , killHandle
  -- , spawnPipe'
  -- , spawnPipe
  -- , spawnPipeArgs
  , createProcess'
  , readCreateProcessWithExitCode'
  , proc'
  , shell'
  , spawn
  , spawnAt
  , module System.Process
  ) where

import           Control.Concurrent
import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class

-- import           Data.Maybe

import qualified RIO.Text               as T

import           System.Directory
import           System.Exit
import           System.IO
-- import           System.Posix.Signals
import           System.Process

import           XMonad.Core            hiding (spawn)

-- | Block until a PID has exited (in any form)
-- ASSUMPTION on linux PIDs will always increase until they overflow, in which
-- case they will start to recycle. Barring any fork bombs, this code should
-- work because we can reasonably expect that no processes will spawn with the
-- same PID within the delay limit
-- TODO this will not work if the process is a zombie (maybe I care...)
waitUntilExit :: Show t => t -> IO ()
waitUntilExit pid = do
  res <- doesDirectoryExist $ "/proc/" ++ show pid
  when res $ do
    threadDelay 100000
    waitUntilExit pid

withDefaultSignalHandlers :: IO a -> IO a
withDefaultSignalHandlers =
  bracket_ uninstallSignalHandlers installSignalHandlers

addGroupSession :: CreateProcess -> CreateProcess
addGroupSession cp = cp { create_group = True, new_session = True }

createProcess' :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess' = withDefaultSignalHandlers . createProcess

readCreateProcessWithExitCode' :: CreateProcess -> String
  -> IO (ExitCode, T.Text, T.Text)
readCreateProcessWithExitCode' c i = withDefaultSignalHandlers $ do
  (r, e, p) <- readCreateProcessWithExitCode c i
  return (r, T.pack e, T.pack p)

shell' :: String -> CreateProcess
shell' = addGroupSession . shell

proc' :: FilePath -> [String] -> CreateProcess
proc' cmd args = addGroupSession $ proc cmd args

spawn :: MonadIO m => String -> m ()
spawn = io . void . createProcess' . shell'

spawnAt :: MonadIO m => FilePath -> String -> m ()
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }