FIX disconnect from all clients

This commit is contained in:
Nathan Dwarshuis 2022-07-09 18:04:26 -04:00
parent 7ae05272e7
commit f7ef373f78
2 changed files with 13 additions and 12 deletions

View File

@ -45,6 +45,9 @@ class SafeClient c where
getDBusClient :: IO (Maybe c) getDBusClient :: IO (Maybe c)
disconnectDBusClient :: c -> IO ()
disconnectDBusClient = disconnect . toClient
withDBusClient :: (c -> IO a) -> IO (Maybe a) withDBusClient :: (c -> IO a) -> IO (Maybe a)
withDBusClient f = do withDBusClient f = do
client <- getDBusClient client <- getDBusClient

View File

@ -43,34 +43,35 @@ connectDBus = do
sys <- getDBusClient sys <- getDBusClient
return DBusState { dbSesClient = ses, dbSysClient = sys } return DBusState { dbSesClient = ses, dbSysClient = sys }
-- TODO why is this only the session client?
-- | Disconnect from the DBus -- | Disconnect from the DBus
disconnectDBus :: DBusState -> IO () disconnectDBus :: DBusState -> IO ()
disconnectDBus db = forM_ (toClient <$> dbSysClient db) disconnect disconnectDBus db = disc dbSesClient >> disc dbSysClient
where
disc f = maybe (return ()) disconnectDBusClient $ f db
-- | Connect to the DBus and request the XMonad name -- | Connect to the DBus and request the XMonad name
connectDBusX :: IO DBusState connectDBusX :: IO DBusState
connectDBusX = do connectDBusX = do
db <- connectDBus db <- connectDBus
forM_ (toClient <$> dbSesClient db) requestXMonadName forM_ (dbSesClient db) requestXMonadName
return db return db
-- | Disconnect from DBus and release the XMonad name -- | Disconnect from DBus and release the XMonad name
disconnectDBusX :: DBusState -> IO () disconnectDBusX :: DBusState -> IO ()
disconnectDBusX db = do disconnectDBusX db = do
forM_ (toClient <$> dbSesClient db) releaseXMonadName forM_ (dbSesClient db) releaseXMonadName
disconnectDBus db disconnectDBus db
-- | All exporter features to be assigned to the DBus -- | All exporter features to be assigned to the DBus
dbusExporters :: [Maybe SesClient -> SometimesIO] dbusExporters :: [Maybe SesClient -> SometimesIO]
dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard] dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
releaseXMonadName :: Client -> IO () releaseXMonadName :: SesClient -> IO ()
releaseXMonadName cl = void $ releaseName cl xmonadBusName releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
requestXMonadName :: Client -> IO () requestXMonadName :: SesClient -> IO ()
requestXMonadName client = do requestXMonadName ses = do
res <- requestName client xmonadBusName [] res <- requestName (toClient ses) xmonadBusName []
-- TODO if the client is not released on shutdown the owner will be different -- TODO if the client is not released on shutdown the owner will be different
let msg | res == NamePrimaryOwner = Nothing let msg | res == NamePrimaryOwner = Nothing
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
@ -80,6 +81,3 @@ requestXMonadName client = do
forM_ msg putStrLn forM_ msg putStrLn
where where
xn = "'" ++ formatBusName xmonadBusName ++ "'" xn = "'" ++ formatBusName xmonadBusName ++ "'"
-- executeExporters :: Maybe Client -> IO ()
-- executeExporters cl = mapM_ (\f -> executeSometimes $ f cl) dbusExporters