ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH log dbus name registration in function

This commit is contained in:
Nathan Dwarshuis 2022-12-31 23:33:06 -05:00
parent 745a548baf
commit 4206893967
2 changed files with 18 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
bin/xmonad.hs
View File

@ -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

32
lib/XMonad/Internal/DBus/Control.hs
View File

@ -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