ENH log dbus name registration in function
This commit is contained in:
parent
745a548baf
commit
4206893967
|
@ -95,8 +95,8 @@ run = do
|
||||||
withXmobar $ \xmobarP -> do
|
withXmobar $ \xmobarP -> do
|
||||||
withChildDaemons fs $ \ds -> do
|
withChildDaemons fs $ \ds -> do
|
||||||
let ts = ThreadState ds (Just xmobarP)
|
let ts = ThreadState ds (Just xmobarP)
|
||||||
startRemovableMon db fs
|
void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db
|
||||||
startPowerMon fs
|
void $ async $ void $ executeSometimes $ fsPowerMon fs
|
||||||
dws <- startDynWorkspaces fs
|
dws <- startDynWorkspaces fs
|
||||||
kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
|
kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
|
||||||
sk <- evalAlways $ fsShowKeys fs
|
sk <- evalAlways $ fsShowKeys fs
|
||||||
|
@ -122,12 +122,6 @@ run = do
|
||||||
}
|
}
|
||||||
io $ runXMonad conf
|
io $ runXMonad conf
|
||||||
where
|
where
|
||||||
startRemovableMon db fs =
|
|
||||||
void $
|
|
||||||
executeSometimes $
|
|
||||||
fsRemovableMon fs $
|
|
||||||
dbSysClient db
|
|
||||||
startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
|
|
||||||
startDynWorkspaces fs = do
|
startDynWorkspaces fs = do
|
||||||
dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
|
dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
|
||||||
void $ io $ async $ runWorkspaceMon dws
|
void $ io $ async $ runWorkspaceMon dws
|
||||||
|
|
|
@ -28,6 +28,7 @@ import DBus.Client
|
||||||
import Data.Internal.DBus
|
import Data.Internal.DBus
|
||||||
import Data.Internal.Dependency
|
import Data.Internal.Dependency
|
||||||
import RIO
|
import RIO
|
||||||
|
import qualified RIO.Text as T
|
||||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
|
@ -51,14 +52,7 @@ withDBusX
|
||||||
-> m (Maybe a)
|
-> m (Maybe a)
|
||||||
withDBusX f = withDBus $ \db -> do
|
withDBusX f = withDBus $ \db -> do
|
||||||
forM (dbSesClient db) $ \ses -> do
|
forM (dbSesClient db) $ \ses -> do
|
||||||
bracket_ (up ses) (down ses) $ f db
|
bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db
|
||||||
where
|
|
||||||
up cl = do
|
|
||||||
logInfo "registering xmonad to DBus"
|
|
||||||
requestXMonadName cl
|
|
||||||
down cl = do
|
|
||||||
logInfo "unregistering xmonad from DBus"
|
|
||||||
releaseXMonadName cl
|
|
||||||
|
|
||||||
withDBus_
|
withDBus_
|
||||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
@ -109,17 +103,23 @@ dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
|
||||||
releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
|
releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
|
||||||
releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
|
releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
|
||||||
|
|
||||||
requestXMonadName :: MonadUnliftIO m => SesClient -> m ()
|
requestXMonadName
|
||||||
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> SesClient
|
||||||
|
-> m ()
|
||||||
requestXMonadName ses = do
|
requestXMonadName ses = do
|
||||||
res <- liftIO $ requestName (toClient ses) xmonadBusName []
|
res <- liftIO $ requestName (toClient ses) xmonadBusName []
|
||||||
-- TODO if the client is not released on shutdown the owner will be different
|
|
||||||
let msg
|
let msg
|
||||||
| res == NamePrimaryOwner = Nothing
|
| res == NamePrimaryOwner = "registering name"
|
||||||
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
|
| res == NameAlreadyOwner = "this process already owns name"
|
||||||
| res == NameInQueue
|
| res == NameInQueue
|
||||||
|| res == NameExists =
|
|| res == NameExists =
|
||||||
Just $ "another process owns " ++ xn
|
"another process owns name"
|
||||||
| otherwise = Just $ "unknown error when requesting " ++ xn
|
| otherwise = "unknown error when requesting name"
|
||||||
liftIO $ forM_ msg putStrLn
|
logInfo $ msg <> ": " <> xn
|
||||||
where
|
where
|
||||||
xn = "'" ++ formatBusName xmonadBusName ++ "'"
|
xn =
|
||||||
|
Utf8Builder $
|
||||||
|
encodeUtf8Builder $
|
||||||
|
T.pack $
|
||||||
|
formatBusName xmonadBusName
|
||||||
|
|
Loading…
Reference in New Issue