xmonad-config/lib/XMonad/Internal/DBus/Control.hs

84 lines
2.5 KiB
Haskell
Raw Normal View History

{-# LANGUAGE ScopedTypeVariables #-}
2020-03-20 00:51:36 -04:00
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | High-level interface for managing XMonad's DBus
2020-04-01 20:17:47 -04:00
module XMonad.Internal.DBus.Control
( Client
2022-07-03 18:23:32 -04:00
, DBusState(..)
, connectDBus
, connectDBusX
, disconnectDBus
, disconnectDBusX
, getDBusClient
2021-11-23 18:28:38 -05:00
, withDBusClient
, withDBusClient_
, disconnect
, dbusExporters
2020-04-01 20:17:47 -04:00
) where
2020-03-20 00:51:36 -04:00
2022-07-03 18:23:32 -04:00
import Control.Monad
2021-11-20 15:20:22 -05:00
2022-07-09 17:44:14 -04:00
import Data.Internal.DBus
import Data.Internal.Dependency
import DBus
import DBus.Client
2020-03-20 00:51:36 -04:00
2021-11-21 00:42:40 -05:00
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
2021-11-20 15:20:22 -05:00
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common
2020-04-01 20:17:47 -04:00
import XMonad.Internal.DBus.Screensaver
2022-07-03 18:23:32 -04:00
-- | Current connections to the DBus (session and system buses)
data DBusState = DBusState
2022-07-09 17:08:10 -04:00
{ dbSesClient :: Maybe SesClient
, dbSysClient :: Maybe SysClient
2022-07-03 18:23:32 -04:00
}
2020-03-20 00:51:36 -04:00
2022-07-03 18:23:32 -04:00
-- | Connect to the DBus
connectDBus :: IO DBusState
connectDBus = do
2022-07-09 17:08:10 -04:00
ses <- getDBusClient
sys <- getDBusClient
2022-07-03 18:23:32 -04:00
return DBusState { dbSesClient = ses, dbSysClient = sys }
-- | Disconnect from the DBus
disconnectDBus :: DBusState -> IO ()
2022-07-09 18:04:26 -04:00
disconnectDBus db = disc dbSesClient >> disc dbSysClient
where
disc f = maybe (return ()) disconnectDBusClient $ f db
2022-07-03 18:23:32 -04:00
-- | Connect to the DBus and request the XMonad name
connectDBusX :: IO DBusState
connectDBusX = do
db <- connectDBus
2022-07-09 18:04:26 -04:00
forM_ (dbSesClient db) requestXMonadName
2022-07-03 18:23:32 -04:00
return db
-- | Disconnect from DBus and release the XMonad name
disconnectDBusX :: DBusState -> IO ()
disconnectDBusX db = do
2022-07-09 18:04:26 -04:00
forM_ (dbSesClient db) releaseXMonadName
2022-07-03 18:23:32 -04:00
disconnectDBus db
-- | All exporter features to be assigned to the DBus
2022-07-09 17:08:10 -04:00
dbusExporters :: [Maybe SesClient -> SometimesIO]
2022-07-03 18:23:32 -04:00
dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
2022-07-09 18:04:26 -04:00
releaseXMonadName :: SesClient -> IO ()
releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
2021-11-20 15:20:22 -05:00
2022-07-09 18:04:26 -04:00
requestXMonadName :: SesClient -> IO ()
requestXMonadName ses = do
res <- requestName (toClient ses) xmonadBusName []
2021-11-21 00:42:40 -05:00
-- TODO if the client is not released on shutdown the owner will be different
2021-11-20 15:20:22 -05:00
let msg | res == NamePrimaryOwner = Nothing
| res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
| res == NameInQueue
|| res == NameExists = Just $ "another process owns " ++ xn
| otherwise = Just $ "unknown error when requesting " ++ xn
forM_ msg putStrLn
where
xn = "'" ++ formatBusName xmonadBusName ++ "'"