ENH use rio proc for xmobar startup

bin/xmonad.hs

@@ -21,6 +21,7 @@ import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Extras
 
 import           RIO                                            (async)
+import           RIO.Process
 import qualified RIO.Text                                       as T
 
 import           System.Directory
@@ -29,7 +30,10 @@ import           System.IO                                      hiding
     ( hPutStrLn
     )
 import           System.IO.Error
-import           System.Process
+import           System.Process                                 hiding
+    ( createPipe
+    , proc
+    )
 
 import           XMonad
 import           XMonad.Actions.CopyWindow
@@ -53,7 +57,7 @@ import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Removable
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Process
+import           XMonad.Internal.Process                        (killHandle)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                          as XT
 import           XMonad.Layout.MultiToggle
@@ -152,7 +156,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
   let fs = features cl
   tt <- evalAlways $ fsTabbedTheme fs
   startDBusInterfaces fs
-  (xmobarHandle, ts) <- startChildDaemons fs
+  ts <- startChildDaemons fs
   startRemovableMon fs
   startPowerMon fs
   dws <- startDynWorkspaces fs
@@ -170,7 +174,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
           , handleEventHook = myEventHook ha
           , startupHook = myStartupHook
           , workspaces = myWorkspaces
-          , logHook = maybe logViewports myLoghook xmobarHandle
+          , logHook = maybe logViewports myLoghook $ tsXmobar ts
           , clickJustFocuses = False
           , focusFollowsMouse = False
           , normalBorderColor = T.unpack XT.bordersColor
@@ -181,12 +185,14 @@ evalConf db@DBusState { dbSysClient = cl } = do
     startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
       $ fsDBusExporters fs
     startChildDaemons fs = do
-      (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
-      io $ case h of
-        Just h' -> hSetBuffering h' LineBuffering
-        Nothing -> return ()
+      p <- proc "xmobar" [] (startProcess . setStdin createPipe)
+      -- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
+      io $ hSetBuffering (getStdin p) LineBuffering
+      -- io $ case h of
+      --   Just h' -> hSetBuffering h' LineBuffering
+      --   Nothing -> return ()
       ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
-      return (h, ThreadState (p:ps) $ maybeToList h)
+      return $ ThreadState ps $ Just p
     startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
                         $ dbSysClient db
     startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
@@ -215,7 +221,7 @@ allFeatures db = do
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   return (dbus ++ others, Left runScreenLock:bfs, allDWs')
   where
-    ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
+    ts = ThreadState { tsChildPIDs = [], tsXmobar = Nothing }
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"
@@ -228,7 +234,7 @@ usage = putStrLn $ intercalate "\n"
 
 data ThreadState = ThreadState
     { tsChildPIDs :: [ProcessHandle]
-    , tsChildHandles :: [Handle]
+    , tsXmobar    :: Maybe (Process Handle () ())
     }
 
 -- TODO shouldn't this be run by a signal handler?
@@ -395,7 +401,7 @@ runHide = sendMessage $ Toggle HIDE
 -- | Loghook configuration
 --
 
-myLoghook :: Handle -> X ()
+myLoghook :: Process Handle () () -> X ()
 myLoghook h = do
   logXinerama h
   logViewports
@@ -452,9 +458,9 @@ whenChanged v action = do
 -- screen. The "<>" is the workspace that currently has focus. N is the number
 -- of windows on the current workspace.
 
-logXinerama :: Handle -> X ()
-logXinerama h = withWindowSet $ \ws -> io
-  $ hPutStrLn h
+logXinerama :: Process Handle () () -> X ()
+logXinerama p = withWindowSet $ \ws -> io
+  $ hPutStrLn (getStdin p)
   $ T.unwords
   $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
   where