2021-06-21 23:41:57 -04:00
|
|
|
{-# 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
|
2020-03-28 14:44:50 -04:00
|
|
|
( Client
|
|
|
|
, startXMonadService
|
2020-04-01 20:17:47 -04:00
|
|
|
, stopXMonadService
|
2021-06-21 23:41:57 -04:00
|
|
|
, pathExists
|
|
|
|
, xmonadBus
|
2020-04-01 20:17:47 -04:00
|
|
|
) where
|
2020-03-20 00:51:36 -04:00
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
import Data.Either
|
|
|
|
|
|
|
|
import DBus
|
2020-03-28 14:44:50 -04:00
|
|
|
import DBus.Client
|
2020-03-20 00:51:36 -04:00
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
import XMonad.Internal.DBus.Common
|
2020-04-01 20:17:47 -04:00
|
|
|
import XMonad.Internal.DBus.IntelBacklight
|
|
|
|
import XMonad.Internal.DBus.Screensaver
|
2021-06-20 22:26:58 -04:00
|
|
|
import XMonad.Internal.Shell
|
2020-04-01 20:17:47 -04:00
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
introspectInterface :: InterfaceName
|
|
|
|
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
|
|
|
|
|
|
|
introspectMethod :: MemberName
|
|
|
|
introspectMethod = memberName_ "Introspect"
|
|
|
|
|
2021-06-20 22:26:58 -04:00
|
|
|
startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
|
2020-03-20 00:51:36 -04:00
|
|
|
startXMonadService = do
|
|
|
|
client <- connectSession
|
2021-06-21 23:41:57 -04:00
|
|
|
requestResult <- requestName client xmonadBus []
|
2020-03-20 00:51:36 -04:00
|
|
|
-- TODO if the client is not released on shutdown the owner will be
|
|
|
|
-- different
|
2021-06-20 20:54:23 -04:00
|
|
|
if requestResult /= NamePrimaryOwner then do
|
2020-03-20 00:51:36 -04:00
|
|
|
putStrLn "Another service owns \"org.xmonad\""
|
2021-06-20 22:26:58 -04:00
|
|
|
return (client, Nothing, Ignore)
|
2020-03-20 00:51:36 -04:00
|
|
|
else do
|
|
|
|
putStrLn "Started xmonad dbus client"
|
2021-06-20 20:54:23 -04:00
|
|
|
bc <- exportIntelBacklight client
|
2021-06-20 22:26:58 -04:00
|
|
|
sc <- exportScreensaver client
|
|
|
|
return (client, bc, sc)
|
2020-03-20 00:51:36 -04:00
|
|
|
|
|
|
|
stopXMonadService :: Client -> IO ()
|
|
|
|
stopXMonadService client = do
|
2021-06-21 23:41:57 -04:00
|
|
|
_ <- releaseName client xmonadBus
|
2020-03-20 00:51:36 -04:00
|
|
|
disconnect client
|
|
|
|
return ()
|
|
|
|
|
2021-06-21 23:41:57 -04:00
|
|
|
pathExists :: Bool -> BusName -> ObjectPath -> IO Bool
|
|
|
|
pathExists sysbus n p = do
|
|
|
|
client <- if sysbus then connectSystem else connectSession
|
|
|
|
r <- call client (methodCall p introspectInterface introspectMethod)
|
|
|
|
{ methodCallDestination = Just n }
|
|
|
|
disconnect client
|
|
|
|
return $ isRight r
|