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

61 lines
1.7 KiB
Haskell

--------------------------------------------------------------------------------
-- | Common internal DBus functions
module XMonad.Internal.DBus.Common
( callMethod
, callMethod'
, addMatchCallback
, xmonadBus
, xmonadBusName
, xDbusDep
-- , initControls
) where
import DBus
import DBus.Client
import XMonad.Internal.Dependency
xmonadBusName :: BusName
xmonadBusName = busName_ "org.xmonad"
xmonadBus :: Bus
xmonadBus = Bus False xmonadBusName
xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
-- connectBus :: Bus -> IO (Maybe Client)
-- | Call a method and return its result if successful
callMethod :: MethodCall -> IO (Maybe [Variant])
callMethod mc = do
client <- connectSession
r <- callMethod' client (Just xmonadBusName) mc
disconnect client
return r
callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
callMethod' client bn mc = do
-- TODO handle clienterrors here
reply <- call client mc { methodCallDestination = bn }
-- TODO not all methods warrant that we wait for a reply? (see callNoReply)
return $ case reply of
Left _ -> Nothing
Right ret -> Just $ methodReturnBody ret
-- | Bind a callback to a signal match rule
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
addMatchCallback rule cb = do
client <- connectSession
addMatch client rule $ cb . signalBody
-- initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
-- initControls client exporter controls = do
-- let x = exporter client
-- e <- evalFeature x
-- case e of
-- (Right c) -> c
-- _ -> return ()
-- return $ controls x