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