REF move process functions to their own module

bin/xmonad.hs

@@ -4,18 +4,17 @@
 module Main (main) where
 
 import           ACPI
-import           DBus.Client                      (Client)
-import           Notify
-import           SendXMsg
-import           Shell
-import           WorkspaceMon
-
 import           DBus.Common
 import           DBus.IntelBacklight
 import           DBus.Screensaver
-
+import           Notify
+import           Process
+import           SendXMsg
+import           Shell
 import qualified Theme                            as T
+import           WorkspaceMon
 
+import           Control.Arrow                    (first)
 import           Control.Concurrent
 import           Control.Monad
     ( forM
@@ -30,27 +29,19 @@ import qualified Data.Map.Lazy                    as M
 import           Data.Maybe                       (catMaybes, isJust)
 import           Data.Monoid                      (All (..))
 
+import           DBus.Client                      (Client)
+
 import           Graphics.X11.Types
 import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 import           Graphics.X11.Xrandr
 
-import           Control.Arrow                    (first)
-import           Control.Exception
-
 import           System.Directory
 import           System.Exit
 import           System.IO
 import           System.Posix.IO
 import           System.Posix.Process
-import           System.Posix.Signals
 import           System.Posix.Types
-import           System.Process                   (waitForProcess)
-import           System.Process.Internals
-    ( ProcessHandle__ (ClosedHandle, OpenHandle)
-    , mkProcessHandle
-    , withProcessHandle
-    )
 
 import           Text.Read                        (readMaybe)
 
@@ -72,12 +63,11 @@ import           XMonad.Layout.PerWorkspace
 import           XMonad.Layout.Tabbed
 import           XMonad.Prompt
 import           XMonad.Prompt.ConfirmPrompt
+import qualified XMonad.StackSet                  as W
 import           XMonad.Util.EZConfig
 import           XMonad.Util.NamedActions
 import           XMonad.Util.Run
 
-import qualified XMonad.StackSet                  as W
-
 main :: IO ()
 main = do
   dbClient <- startXMonadService
@@ -196,9 +186,6 @@ myWindowSetXinerama ws = wsString ++ sep ++ layout
         (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
         (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1
 
-getFocusedScreen :: X Rectangle
-getFocusedScreen = withWindowSet $ return . screenRect . W.screenDetail . W.current
-
 myManageHook :: ManageHook
 myManageHook = composeOne
   -- assume virtualbox is not run with the toolbar in fullscreen mode
@@ -235,7 +222,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
       ACPI -> do
          let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
          forM_ acpiTag $ \case
-           Power -> myPowerPrompt
+           Power -> runPowerPrompt
            Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend
            LidClose -> do
              status <- io isDischarging
@@ -281,8 +268,8 @@ instance Enum PowerAction where
   fromEnum Hibernate = 2
   fromEnum Reboot    = 3
 
-myPowerPrompt :: X ()
+runPowerPrompt :: X ()
-myPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
+runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
   where
     comp = mkComplFunFromList []
     theme = T.promptTheme { promptKeymap = keymap }
@@ -303,8 +290,8 @@ myPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
       Hibernate -> runScreenLock >> runHibernate
       Reboot    -> runReboot
 
-myQuitPrompt :: X ()
+runQuitPrompt :: X ()
-myQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
+runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
 
 -- TODO for some reason the screen never wakes up after suspend when
 -- the nvidia card is up, so block suspend if nvidia card is running
@@ -377,6 +364,9 @@ getMonitorName = do
       (Rectangle x y _ _) <- getFocusedScreen
       return (fromIntegral x, fromIntegral y)
 
+getFocusedScreen :: X Rectangle
+getFocusedScreen = withWindowSet $ return . screenRect . W.screenDetail . W.current
+
 spawnDmenuCmd :: String -> [String] -> X ()
 spawnDmenuCmd cmd args = do
   name <- getMonitorName
@@ -454,21 +444,6 @@ runCleanup ps client = io $ do
   mapM_ killPID ps
   stopXMonadService client
 
-killPID :: ProcessID -> IO ()
-killPID pID = do
-  h <- mkProcessHandle pID False
-  -- this may fail of the PID does not exist
-  _ <- try $ sendSIGTERM h :: IO (Either IOException ())
-  -- this may fail if the process exits instantly and the handle
-  -- is destroyed by the time we get to this line (I think?)
-  _ <- try $ waitForProcess h :: IO (Either IOException ExitCode)
-  return ()
-  where
-    sendSIGTERM h = withProcessHandle h $ \case
-      OpenHandle _ -> signalProcess sigTERM pID
-      ClosedHandle _ -> return ()
-      _ -> return () -- this should never happen
-
 runRestart :: X ()
 runRestart = restart "xmonad" True
 
@@ -630,6 +605,7 @@ myKeys hs client c =
   , ("M-C-t", addName "launch terminal" runTerm)
   , ("M-C-q", addName "launch calc" runCalc)
   , ("M-C-f", addName "launch file manager" runFileManager)
+  -- TODO shoudn't these be flipped?
   , ("M-C-v", addName "launch windows VM" $ runVBox >> appendWorkspace myVMWorkspace)
   , ("M-C-g", addName "launch GIMP" $ runGimp >> appendWorkspace myGimpWorkspace)
   ] ++
@@ -653,7 +629,7 @@ myKeys hs client c =
   , ("M-M1-=", addName "toggle screensaver" toggleDPMS)
   , ("M-<F2>", addName "restart xmonad" $ runCleanup hs client >> runRestart)
   , ("M-S-<F2>", addName "recompile xmonad" runRecompile)
-  , ("M-<End>", addName "power menu" myPowerPrompt)
+  , ("M-<End>", addName "power menu" runPowerPrompt)
-  , ("M-<Home>", addName "quit xmonad" myQuitPrompt)
+  , ("M-<Home>", addName "quit xmonad" runQuitPrompt)
   , ("M-<Esc>", addName "switch gpu" runOptimusPrompt)
   ]

lib/Process.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Process where
+
+import           Control.Concurrent
+import           Control.Exception
+import           Control.Monad
+
+import           System.Directory
+import           System.Exit
+import           System.Posix.Signals
+import           System.Posix.Types
+import           System.Process           (waitForProcess)
+import           System.Process.Internals
+    ( ProcessHandle__ (ClosedHandle, OpenHandle)
+    , mkProcessHandle
+    , withProcessHandle
+    )
+
+-- | 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 $ threadDelay 100000 >> waitUntilExit pid
+
+killPID :: ProcessID -> IO ()
+killPID pid = do
+  h <- mkProcessHandle pid False
+  -- this may fail of the PID does not exist
+  _ <- try $ sendSIGTERM h :: IO (Either IOException ())
+  -- this may fail if the process exits instantly and the handle
+  -- is destroyed by the time we get to this line (I think?)
+  _ <- try $ waitForProcess h :: IO (Either IOException ExitCode)
+  return ()
+  where
+    sendSIGTERM h = withProcessHandle h $ \case
+      OpenHandle _ -> signalProcess sigTERM pid
+      ClosedHandle _ -> return ()
+      _ -> return () -- this should never happen

lib/WorkspaceMon.hs

@@ -2,6 +2,7 @@
 
 module WorkspaceMon (M.fromList, runWorkspaceMon) where
 
+import           Process
 import           SendXMsg
 
 import qualified Data.Map                  as M
@@ -19,7 +20,6 @@ import           Graphics.X11.Xlib.Extras
 import           Graphics.X11.Xlib.Misc
 import           Graphics.X11.Xlib.Types
 
-import           System.Directory
 import           System.Process            (Pid)
 
 -- TOOD it would be really nice if the manner we used to match windows was
@@ -81,18 +81,8 @@ handle curPIDs MapNotifyEvent { ev_window = w } = do
 handle _ _ = return ()
 
 waitAndKill :: String -> Pid -> IO ()
-waitAndKill tag pid = waitUntilExit pidDir
+waitAndKill tag pid = waitUntilExit pid >> sendXMsg Workspace tag
-  where
+
-    pidDir = "/proc/" ++ show pid
-    waitUntilExit d = do
-      -- TODO this will not work if the process is a zombie (maybe I care...)
-      -- 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
-      res <- doesDirectoryExist d
-      if res then threadDelay 100000 >> waitUntilExit d
-      else sendXMsg Workspace tag
 
 withUniquePid :: WatchedPIDs -> Pid -> IO () -> IO ()
 withUniquePid curPIDs pid f = do

my-xmonad.cabal

@@ -15,6 +15,7 @@ library
                    , DBus.IntelBacklight
                    , DBus.Internal
                    , DBus.Screensaver
+                   , Process
                    , Xmobar.Common
                    , Xmobar.Plugins.Bluetooth
                    , Xmobar.Plugins.IntelBacklight
@@ -29,6 +30,7 @@ library
                  , fdo-notify
                  , io-streams >= 1.5.1.0
                  , mtl >= 2.2.2
+                 , unix >= 2.7.2.2
                  , tcp-streams >= 1.0.1.1
                  , text >= 1.2.3.1
                  , directory >= 1.3.3.0
@@ -47,7 +49,6 @@ executable xmonad
                  , dbus >= 1.2.7
                  , directory >= 1.3.3.0
                  , my-xmonad
-                 , process >= 1.6.5.0
                  , unix >= 2.7.2.2
                  , xmonad >= 0.13
                  , xmonad-contrib >= 0.13