REF clean up process
This commit is contained in:
parent
f5ee8882bc
commit
246208e3cf
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
module XMonad.Internal.Process
|
module XMonad.Internal.Process
|
||||||
( waitUntilExit
|
( waitUntilExit
|
||||||
, killHandle
|
-- , killHandle
|
||||||
-- , spawnPipe'
|
-- , spawnPipe'
|
||||||
-- , spawnPipe
|
-- , spawnPipe
|
||||||
-- , spawnPipeArgs
|
-- , spawnPipeArgs
|
||||||
|
@ -21,14 +21,14 @@ import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import Data.Maybe
|
-- import Data.Maybe
|
||||||
|
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.Signals
|
-- import System.Posix.Signals
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
|
@ -42,17 +42,9 @@ import XMonad.Core hiding (spawn)
|
||||||
waitUntilExit :: Show t => t -> IO ()
|
waitUntilExit :: Show t => t -> IO ()
|
||||||
waitUntilExit pid = do
|
waitUntilExit pid = do
|
||||||
res <- doesDirectoryExist $ "/proc/" ++ show pid
|
res <- doesDirectoryExist $ "/proc/" ++ show pid
|
||||||
when res $ threadDelay 100000 >> waitUntilExit pid
|
when res $ do
|
||||||
|
threadDelay 100000
|
||||||
killHandle :: ProcessHandle -> IO ()
|
waitUntilExit pid
|
||||||
killHandle ph = do
|
|
||||||
ec <- getProcessExitCode ph
|
|
||||||
unless (isJust ec) $ do
|
|
||||||
pid <- getPid ph
|
|
||||||
forM_ pid $ signalProcess sigTERM
|
|
||||||
-- this may fail if the process exits instantly and the handle
|
|
||||||
-- is destroyed by the time we get to this line (I think?)
|
|
||||||
void (try $ waitForProcess ph :: IO (Either IOException ExitCode))
|
|
||||||
|
|
||||||
withDefaultSignalHandlers :: IO a -> IO a
|
withDefaultSignalHandlers :: IO a -> IO a
|
||||||
withDefaultSignalHandlers =
|
withDefaultSignalHandlers =
|
||||||
|
@ -81,16 +73,3 @@ spawn = io . void . createProcess' . shell'
|
||||||
|
|
||||||
spawnAt :: MonadIO m => FilePath -> String -> m ()
|
spawnAt :: MonadIO m => FilePath -> String -> m ()
|
||||||
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
|
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
|
||||||
|
|
||||||
-- spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle)
|
|
||||||
-- spawnPipe' cp = do
|
|
||||||
-- -- ASSUME creating a pipe will always succeed in making a Just Handle
|
|
||||||
-- (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
|
|
||||||
-- hSetBuffering h LineBuffering
|
|
||||||
-- return (h, p)
|
|
||||||
|
|
||||||
-- spawnPipe :: String -> IO (Handle, ProcessHandle)
|
|
||||||
-- spawnPipe = spawnPipe' . shell
|
|
||||||
|
|
||||||
-- spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
|
|
||||||
-- spawnPipeArgs cmd = spawnPipe' . proc cmd
|
|
||||||
|
|
Loading…
Reference in New Issue