diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 1f7eb21..267dc02 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -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 diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index e490c38..1799442 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -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