ENH use logger in disconnect

bin/xmonad.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 
 --------------------------------------------------------------------------------
 --  XMonad binary
@@ -98,7 +99,9 @@ run = do
           void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
           void $ async $ void $ executeSometimes $ fsPowerMon fs
           dws <- startDynWorkspaces fs
-          kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
+          runIO <- askRunInIO
+          let cleanup = runCleanup runIO ts db
+          kbs <- filterExternal <$> evalExternal (fsKeys fs cleanup ts db)
           sk <- evalAlways $ fsShowKeys fs
           ha <- evalAlways $ fsACPIHandler fs
           tt <- evalAlways $ fsTabbedTheme fs
@@ -151,7 +154,7 @@ getCreateDirectories = do
         _ -> return ()
 
 data FeatureSet = FeatureSet
-  { fsKeys :: ThreadState -> DBusState -> [KeyGroup FeatureX]
+  { fsKeys :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
   , fsDBusExporters :: [Maybe SesClient -> SometimesIO]
   , fsPowerMon :: SometimesIO
   , fsRemovableMon :: Maybe SysClient -> SometimesIO
@@ -222,10 +225,11 @@ printDeps = withDBus_ $ \db -> do
             fmap dumpFeature f ++ fmap dumpSometimes i ++ fmap dumpSometimes d
 
 allFeatures :: DBusState -> FIO ([SometimesIO], [FeatureX], [Sometimes DynWorkspace])
-allFeatures db = do
+allFeatures db = withRunInIO $ \runIO -> do
+  let cleanup = runCleanup runIO ts db
   let bfs =
         concatMap (fmap kbMaybeAction . kgBindings) $
-          externalBindings ts db
+          externalBindings cleanup ts db
   let dbus = fmap (\f -> f $ dbSesClient db) dbusExporters
   let others = [runRemovableMon $ dbSysClient db, runPowermon]
   return (dbus ++ others, Left runScreenLock : bfs, allDWs')
@@ -249,11 +253,16 @@ data ThreadState = ThreadState
   , tsXmobar :: Maybe (Process Handle () ())
   }
 
-runCleanup :: ThreadState -> DBusState -> X ()
-runCleanup ts db = io $ do
+runCleanup
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => (m () -> IO ())
+  -> ThreadState
+  -> DBusState
+  -> X ()
+runCleanup runIO ts db = io $ do
   mapM_ killNoWait $ tsXmobar ts
   mapM_ killNoWait $ tsChildPIDs ts
-  disconnectDBusX db
+  liftIO $ runIO $ disconnectDBusX db
 
 -- | Kill a process (group) after xmonad has already started
 -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
@@ -739,8 +748,8 @@ filterExternal = fmap go
             ]
         }
 
-externalBindings :: ThreadState -> DBusState -> [KeyGroup FeatureX]
-externalBindings ts db =
+externalBindings :: X () -> ThreadState -> DBusState -> [KeyGroup FeatureX]
+externalBindings cleanup _ db =
   [ KeyGroup
       "Launchers"
       [ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
@@ -816,7 +825,7 @@ externalBindings ts db =
     ib = Left . brightessControls intelBacklightControls
     ck = Left . brightessControls clevoKeyboardControls
     ftrAlways n = Right . Always n . Always_ . FallbackAlone
-    restartf = ftrAlways "restart function" (runCleanup ts db >> runRestart)
+    restartf = ftrAlways "restart function" (cleanup >> runRestart)
     recompilef = ftrAlways "recompile function" runRecompile
 
 type MaybeX = Maybe (X ())

lib/XMonad/Internal/DBus/Control.hs

@@ -91,7 +91,10 @@ connectDBusX = do
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: MonadUnliftIO m => DBusState -> m ()
+disconnectDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => DBusState
+  -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -100,8 +103,14 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
-releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SesClient
+  -> m ()
+releaseXMonadName ses = do
+  -- TODO this might error?
+  liftIO $ void $ releaseName (toClient ses) xmonadBusName
+  logInfo "released xmonad name"
 
 requestXMonadName
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)