REF move bus to endpoint type

This commit is contained in:
Nathan Dwarshuis 2021-11-21 23:55:19 -05:00
parent 27189cb335
commit 866d2cbb75
7 changed files with 32 additions and 82 deletions

View File

@ -41,7 +41,6 @@ import XMonad.Hooks.DynamicLog
import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Common
import XMonad.Internal.DBus.Control
import XMonad.Internal.Shell
-- import XMonad.Internal.DBus.Common (xmonadBus)
@ -230,9 +229,6 @@ dateCmd = CmdSpec
-- some commands depend on the presence of interfaces that can only be
-- determined at runtime; define these checks here
-- dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency
-- dbusDep usesys bus obj iface mem = DBusEndpoint (Bus usesys bus) (Endpoint obj iface mem)
-- in the case of network interfaces, assume that the system uses systemd in
-- which case ethernet interfaces always start with "en" and wireless
-- interfaces always start with "wl"
@ -316,20 +312,22 @@ type BarFeature = Feature CmdSpec
getVPN :: Maybe Client -> BarFeature
getVPN client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const vpnCmd) vpnBus client
[Endpoint vpnPath vpnInterface $ Property_ vpnConnType]
[IOTest vpnPresent]
{ ftrMaybeAction = DBusEndpoint_ (const vpnCmd) client [ep] [dp]
, ftrName = "VPN status indicator"
, ftrWarning = Default
}
where
ep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
dp = IOTest vpnPresent
getBt :: Maybe Client -> BarFeature
getBt client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const btCmd) btBus client
[Endpoint btPath btInterface $ Property_ btPowered] []
{ ftrMaybeAction = DBusEndpoint_ (const btCmd) client [ep] []
, ftrName = "bluetooth status indicator"
, ftrWarning = Default
}
where
ep = Endpoint btBus btPath btInterface $ Property_ btPowered
getAlsa :: BarFeature
getAlsa = Feature
@ -340,21 +338,21 @@ getAlsa = Feature
getBl :: Maybe Client -> BarFeature
getBl client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const blCmd) xmonadBusName client [intelBacklightSignalDep] []
{ ftrMaybeAction = DBusEndpoint_ (const blCmd) client [intelBacklightSignalDep] []
, ftrName = "Intel backlight indicator"
, ftrWarning = Default
}
getCk :: Maybe Client -> BarFeature
getCk client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const ckCmd) xmonadBusName client [clevoKeyboardSignalDep] []
{ ftrMaybeAction = DBusEndpoint_ (const ckCmd) client [clevoKeyboardSignalDep] []
, ftrName = "Clevo keyboard indicator"
, ftrWarning = Default
}
getSs :: Maybe Client -> BarFeature
getSs client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const ssCmd) xmonadBusName client [ssSignalDep] []
{ ftrMaybeAction = DBusEndpoint_ (const ssCmd) client [ssSignalDep] []
, ftrName = "screensaver indicator"
, ftrWarning = Default
}

View File

@ -36,7 +36,7 @@ memRemoved = memberName_ "InterfacesRemoved"
-- dbusDep :: MemberName -> Dependency
-- dbusDep m = DBusEndpoint (Bus True bus) (Endpoint path interface $ Signal_ m)
dbusDep :: MemberName -> Endpoint
dbusDep m = Endpoint path interface $ Signal_ m
dbusDep m = Endpoint bus path interface $ Signal_ m
-- addedDep :: Dependency
addedDep :: Endpoint
@ -90,7 +90,7 @@ listenDevices = do
runRemovableMon :: Maybe Client -> FeatureIO
runRemovableMon client = Feature
{ ftrMaybeAction = DBusEndpoint_ (const listenDevices) bus client [addedDep, removedDep] []
{ ftrMaybeAction = DBusEndpoint_ (const listenDevices) client [addedDep, removedDep] []
, ftrName = "removeable device monitor"
, ftrWarning = Default
}

View File

@ -70,7 +70,7 @@ callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client = do
-- signalDep :: BrightnessConfig a b -> Dependency
signalDep :: BrightnessConfig a b -> Endpoint
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
Endpoint p i $ Signal_ memCur
Endpoint xmonadBusName p i $ Signal_ memCur
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
@ -135,12 +135,6 @@ callBacklight :: Maybe Client -> BrightnessConfig a b -> String -> MemberName ->
callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
(featureEndpoint xmonadBusName p i m client)
{ ftrName = unwords [n, controlName] }
-- Feature
-- { ftrMaybeAction = void $ callMethod client xmonadBusName p i m
-- , ftrName = unwords [n, controlName]
-- , ftrWarning = Default
-- , ftrChildren = [xDbusDep p i $ Method_ m]
-- }
bodyGetBrightness :: Num a => [Variant] -> Maybe a
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

View File

@ -5,7 +5,7 @@ module XMonad.Internal.DBus.Common
-- ( callMethod
-- , callMethod'
( addMatchCallback
, xmonadBus
-- , xmonadBus
, xmonadBusName
-- , xDbusDep
-- , initControls
@ -14,13 +14,13 @@ module XMonad.Internal.DBus.Common
import DBus
import DBus.Client
import XMonad.Internal.Dependency
-- import XMonad.Internal.Dependency
xmonadBusName :: BusName
xmonadBusName = busName_ "org.xmonad"
xmonadBus :: Bus
xmonadBus = Bus False xmonadBusName
-- xmonadBus :: Bus
-- xmonadBus = Bus False xmonadBusName
-- xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
-- xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m

View File

@ -9,7 +9,7 @@ module XMonad.Internal.DBus.Control
, getDBusClient
, stopXMonadService
, pathExists
, xmonadBus
-- , xmonadBus
, disconnect
) where

View File

@ -123,14 +123,6 @@ callToggle :: Maybe Client -> FeatureIO
callToggle client =
(featureEndpoint xmonadBusName ssPath interface memToggle client)
{ ftrName = "screensaver toggle" }
-- callToggle client = Feature
-- { ftrMaybeAction = cmd
-- , ftrName = "screensaver toggle"
-- , ftrWarning = Default
-- , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
-- }
-- where
-- cmd = void $ callMethod client xmonadBusName ssPath interface memToggle
callQuery :: Client -> IO (Maybe SSState)
callQuery client = do
@ -140,8 +132,5 @@ callQuery client = do
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
-- ssSignalDep :: Dependency
ssSignalDep :: Endpoint
-- ssSignalDep = DBusEndpoint xmonadBus $ Endpoint ssPath interface
-- $ Signal_ memState
ssSignalDep = Endpoint ssPath interface $ Signal_ memState
ssSignalDep = Endpoint xmonadBusName ssPath interface $ Signal_ memState

View File

@ -14,7 +14,6 @@ module XMonad.Internal.Dependency
, Warning(..)
, Dependency(..)
, UnitType(..)
, Bus(..)
, Endpoint(..)
, DBusMember(..)
, ioFeature
@ -80,13 +79,13 @@ data Feature a = Feature
data Action a = Parent a [Dependency]
| forall b. Chain (b -> a) (IO (Either [String] b))
| DBusEndpoint_ (Client -> a) BusName (Maybe Client) [Endpoint] [Dependency]
| DBusEndpoint_ (Client -> a) (Maybe Client) [Endpoint] [Dependency]
| DBusBus_ (Client -> a) BusName (Maybe Client) [Dependency]
instance Functor Action where
fmap f (Parent a ds) = Parent (f a) ds
fmap f (Chain a b) = Chain (f . a) b
fmap f (DBusEndpoint_ a b c es ds) = DBusEndpoint_ (f . a) b c es ds
fmap f (DBusEndpoint_ a c es ds) = DBusEndpoint_ (f . a) c es ds
fmap f (DBusBus_ a b c eps) = DBusBus_ (f . a) b c eps
-- TODO this is silly as is, and could be made more useful by representing
@ -122,13 +121,13 @@ featureExeArgs n cmd args =
featureEndpoint :: BusName -> ObjectPath -> InterfaceName -> MemberName
-> Maybe Client -> FeatureIO
featureEndpoint busname path iface mem client = Feature
{ ftrMaybeAction = DBusEndpoint_ cmd busname client deps []
{ ftrMaybeAction = DBusEndpoint_ cmd client deps []
, ftrName = "screensaver toggle"
, ftrWarning = Default
}
where
cmd = \c -> void $ callMethod c busname path iface mem
deps = [Endpoint path iface $ Method_ mem]
deps = [Endpoint busname path iface $ Method_ mem]
--------------------------------------------------------------------------------
-- | Feature evaluation
@ -151,9 +150,9 @@ evalAction (Parent a ds) = do
evalAction (Chain a b) = second a <$> b
evalAction (DBusEndpoint_ _ _ Nothing _ _) = return $ Left ["client not available"]
evalAction (DBusEndpoint_ action busname (Just client) es ds) = do
eperrors <- mapM (endpointSatisfied client busname) es
evalAction (DBusEndpoint_ _ Nothing _ _) = return $ Left ["client not available"]
evalAction (DBusEndpoint_ action (Just client) es ds) = do
eperrors <- mapM (endpointSatisfied client) es
dperrors <- mapM evalDependency ds
return $ case catMaybes (eperrors ++ dperrors) of
[] -> Right $ action client
@ -167,34 +166,6 @@ evalAction (DBusBus_ action busname (Just client) deps) = do
[] -> Right $ action client
es' -> Left es'
-- instance Evaluable Parent where
-- eval (Parent a ds) = do
-- es <- catMaybes <$> mapM evalDependency ds
-- return $ case es of
-- [] -> Right a
-- es' -> Left es'
-- instance Evaluable Chain where
-- eval (Chain a b) = second a <$> b
-- instance Evaluable DBusEndpoint_ where
-- eval (DBusEndpoint_ _ _ Nothing _ _) = return $ Left ["client not available"]
-- eval (DBusEndpoint_ action busname (Just client) es ds) = do
-- eperrors <- mapM (endpointSatisfied client busname) es
-- dperrors <- mapM evalDependency ds
-- return $ case catMaybes (eperrors ++ dperrors) of
-- [] -> Right $ action client
-- es' -> Left es'
-- instance Evaluable DBusBus_ where
-- eval (DBusBus_ _ _ Nothing _) = return $ Left ["client not available"]
-- eval (DBusBus_ action busname (Just client) deps) = do
-- res <- busSatisfied client busname
-- es <- catMaybes . (res:) <$> mapM evalDependency deps
-- return $ case es of
-- [] -> Right $ action client
-- es' -> Left es'
evalFeature :: Feature a -> IO (MaybeAction a)
evalFeature (ConstFeature x) = return $ Right x
evalFeature Feature
@ -246,9 +217,7 @@ data DBusMember = Method_ MemberName
| Property_ String
deriving (Eq, Show)
data Bus = Bus Bool BusName deriving (Eq, Show)
data Endpoint = Endpoint ObjectPath InterfaceName DBusMember deriving (Eq, Show)
data Endpoint = Endpoint BusName ObjectPath InterfaceName DBusMember deriving (Eq, Show)
pathR :: String -> Dependency
pathR n = AccessiblePath n True False
@ -345,8 +314,8 @@ busSatisfied client bus = do
bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
bodyGetNames _ = []
endpointSatisfied :: Client -> BusName -> Endpoint -> IO (Maybe String)
endpointSatisfied client busname (Endpoint objpath iface mem) = do
endpointSatisfied :: Client -> Endpoint -> IO (Maybe String)
endpointSatisfied client (Endpoint busname objpath iface mem) = do
-- client <- if u then connectSystem else connectSession
ret <- callMethod client busname objpath introspectInterface introspectMethod
-- disconnect client