REF move bus to endpoint type
This commit is contained in:
parent
27189cb335
commit
866d2cbb75
|
@ -41,7 +41,6 @@ import XMonad.Hooks.DynamicLog
|
||||||
import XMonad.Internal.Command.Power (hasBattery)
|
import XMonad.Internal.Command.Power (hasBattery)
|
||||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Common
|
|
||||||
import XMonad.Internal.DBus.Control
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
-- import XMonad.Internal.DBus.Common (xmonadBus)
|
-- import XMonad.Internal.DBus.Common (xmonadBus)
|
||||||
|
@ -230,9 +229,6 @@ dateCmd = CmdSpec
|
||||||
-- some commands depend on the presence of interfaces that can only be
|
-- some commands depend on the presence of interfaces that can only be
|
||||||
-- determined at runtime; define these checks here
|
-- 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
|
-- in the case of network interfaces, assume that the system uses systemd in
|
||||||
-- which case ethernet interfaces always start with "en" and wireless
|
-- which case ethernet interfaces always start with "en" and wireless
|
||||||
-- interfaces always start with "wl"
|
-- interfaces always start with "wl"
|
||||||
|
@ -316,20 +312,22 @@ type BarFeature = Feature CmdSpec
|
||||||
|
|
||||||
getVPN :: Maybe Client -> BarFeature
|
getVPN :: Maybe Client -> BarFeature
|
||||||
getVPN client = Feature
|
getVPN client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const vpnCmd) vpnBus client
|
{ ftrMaybeAction = DBusEndpoint_ (const vpnCmd) client [ep] [dp]
|
||||||
[Endpoint vpnPath vpnInterface $ Property_ vpnConnType]
|
|
||||||
[IOTest vpnPresent]
|
|
||||||
, ftrName = "VPN status indicator"
|
, ftrName = "VPN status indicator"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
ep = Endpoint vpnBus vpnPath vpnInterface $ Property_ vpnConnType
|
||||||
|
dp = IOTest vpnPresent
|
||||||
|
|
||||||
getBt :: Maybe Client -> BarFeature
|
getBt :: Maybe Client -> BarFeature
|
||||||
getBt client = Feature
|
getBt client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const btCmd) btBus client
|
{ ftrMaybeAction = DBusEndpoint_ (const btCmd) client [ep] []
|
||||||
[Endpoint btPath btInterface $ Property_ btPowered] []
|
|
||||||
, ftrName = "bluetooth status indicator"
|
, ftrName = "bluetooth status indicator"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
ep = Endpoint btBus btPath btInterface $ Property_ btPowered
|
||||||
|
|
||||||
getAlsa :: BarFeature
|
getAlsa :: BarFeature
|
||||||
getAlsa = Feature
|
getAlsa = Feature
|
||||||
|
@ -340,21 +338,21 @@ getAlsa = Feature
|
||||||
|
|
||||||
getBl :: Maybe Client -> BarFeature
|
getBl :: Maybe Client -> BarFeature
|
||||||
getBl client = Feature
|
getBl client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const blCmd) xmonadBusName client [intelBacklightSignalDep] []
|
{ ftrMaybeAction = DBusEndpoint_ (const blCmd) client [intelBacklightSignalDep] []
|
||||||
, ftrName = "Intel backlight indicator"
|
, ftrName = "Intel backlight indicator"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
|
||||||
getCk :: Maybe Client -> BarFeature
|
getCk :: Maybe Client -> BarFeature
|
||||||
getCk client = Feature
|
getCk client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const ckCmd) xmonadBusName client [clevoKeyboardSignalDep] []
|
{ ftrMaybeAction = DBusEndpoint_ (const ckCmd) client [clevoKeyboardSignalDep] []
|
||||||
, ftrName = "Clevo keyboard indicator"
|
, ftrName = "Clevo keyboard indicator"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
|
||||||
getSs :: Maybe Client -> BarFeature
|
getSs :: Maybe Client -> BarFeature
|
||||||
getSs client = Feature
|
getSs client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const ssCmd) xmonadBusName client [ssSignalDep] []
|
{ ftrMaybeAction = DBusEndpoint_ (const ssCmd) client [ssSignalDep] []
|
||||||
, ftrName = "screensaver indicator"
|
, ftrName = "screensaver indicator"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
|
|
@ -36,7 +36,7 @@ memRemoved = memberName_ "InterfacesRemoved"
|
||||||
-- dbusDep :: MemberName -> Dependency
|
-- dbusDep :: MemberName -> Dependency
|
||||||
-- dbusDep m = DBusEndpoint (Bus True bus) (Endpoint path interface $ Signal_ m)
|
-- dbusDep m = DBusEndpoint (Bus True bus) (Endpoint path interface $ Signal_ m)
|
||||||
dbusDep :: MemberName -> Endpoint
|
dbusDep :: MemberName -> Endpoint
|
||||||
dbusDep m = Endpoint path interface $ Signal_ m
|
dbusDep m = Endpoint bus path interface $ Signal_ m
|
||||||
|
|
||||||
-- addedDep :: Dependency
|
-- addedDep :: Dependency
|
||||||
addedDep :: Endpoint
|
addedDep :: Endpoint
|
||||||
|
@ -90,7 +90,7 @@ listenDevices = do
|
||||||
|
|
||||||
runRemovableMon :: Maybe Client -> FeatureIO
|
runRemovableMon :: Maybe Client -> FeatureIO
|
||||||
runRemovableMon client = Feature
|
runRemovableMon client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ (const listenDevices) bus client [addedDep, removedDep] []
|
{ ftrMaybeAction = DBusEndpoint_ (const listenDevices) client [addedDep, removedDep] []
|
||||||
, ftrName = "removeable device monitor"
|
, ftrName = "removeable device monitor"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
|
|
|
@ -70,7 +70,7 @@ callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } client = do
|
||||||
-- signalDep :: BrightnessConfig a b -> Dependency
|
-- signalDep :: BrightnessConfig a b -> Dependency
|
||||||
signalDep :: BrightnessConfig a b -> Endpoint
|
signalDep :: BrightnessConfig a b -> Endpoint
|
||||||
signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
|
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 :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
|
||||||
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
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 =
|
callBacklight client BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
|
||||||
(featureEndpoint xmonadBusName p i m client)
|
(featureEndpoint xmonadBusName p i m client)
|
||||||
{ ftrName = unwords [n, controlName] }
|
{ 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 :: Num a => [Variant] -> Maybe a
|
||||||
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||||
|
|
|
@ -5,7 +5,7 @@ module XMonad.Internal.DBus.Common
|
||||||
-- ( callMethod
|
-- ( callMethod
|
||||||
-- , callMethod'
|
-- , callMethod'
|
||||||
( addMatchCallback
|
( addMatchCallback
|
||||||
, xmonadBus
|
-- , xmonadBus
|
||||||
, xmonadBusName
|
, xmonadBusName
|
||||||
-- , xDbusDep
|
-- , xDbusDep
|
||||||
-- , initControls
|
-- , initControls
|
||||||
|
@ -14,13 +14,13 @@ module XMonad.Internal.DBus.Common
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
import XMonad.Internal.Dependency
|
-- import XMonad.Internal.Dependency
|
||||||
|
|
||||||
xmonadBusName :: BusName
|
xmonadBusName :: BusName
|
||||||
xmonadBusName = busName_ "org.xmonad"
|
xmonadBusName = busName_ "org.xmonad"
|
||||||
|
|
||||||
xmonadBus :: Bus
|
-- xmonadBus :: Bus
|
||||||
xmonadBus = Bus False xmonadBusName
|
-- xmonadBus = Bus False xmonadBusName
|
||||||
|
|
||||||
-- xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
-- xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
||||||
-- xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
|
-- xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
|
||||||
|
|
|
@ -9,7 +9,7 @@ module XMonad.Internal.DBus.Control
|
||||||
, getDBusClient
|
, getDBusClient
|
||||||
, stopXMonadService
|
, stopXMonadService
|
||||||
, pathExists
|
, pathExists
|
||||||
, xmonadBus
|
-- , xmonadBus
|
||||||
, disconnect
|
, disconnect
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
|
@ -123,14 +123,6 @@ callToggle :: Maybe Client -> FeatureIO
|
||||||
callToggle client =
|
callToggle client =
|
||||||
(featureEndpoint xmonadBusName ssPath interface memToggle client)
|
(featureEndpoint xmonadBusName ssPath interface memToggle client)
|
||||||
{ ftrName = "screensaver toggle" }
|
{ 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 -> IO (Maybe SSState)
|
||||||
callQuery client = do
|
callQuery client = do
|
||||||
|
@ -140,8 +132,5 @@ callQuery client = do
|
||||||
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
|
||||||
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
|
matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
|
||||||
|
|
||||||
-- ssSignalDep :: Dependency
|
|
||||||
ssSignalDep :: Endpoint
|
ssSignalDep :: Endpoint
|
||||||
-- ssSignalDep = DBusEndpoint xmonadBus $ Endpoint ssPath interface
|
ssSignalDep = Endpoint xmonadBusName ssPath interface $ Signal_ memState
|
||||||
-- $ Signal_ memState
|
|
||||||
ssSignalDep = Endpoint ssPath interface $ Signal_ memState
|
|
||||||
|
|
|
@ -14,7 +14,6 @@ module XMonad.Internal.Dependency
|
||||||
, Warning(..)
|
, Warning(..)
|
||||||
, Dependency(..)
|
, Dependency(..)
|
||||||
, UnitType(..)
|
, UnitType(..)
|
||||||
, Bus(..)
|
|
||||||
, Endpoint(..)
|
, Endpoint(..)
|
||||||
, DBusMember(..)
|
, DBusMember(..)
|
||||||
, ioFeature
|
, ioFeature
|
||||||
|
@ -80,13 +79,13 @@ data Feature a = Feature
|
||||||
|
|
||||||
data Action a = Parent a [Dependency]
|
data Action a = Parent a [Dependency]
|
||||||
| forall b. Chain (b -> a) (IO (Either [String] b))
|
| 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]
|
| DBusBus_ (Client -> a) BusName (Maybe Client) [Dependency]
|
||||||
|
|
||||||
instance Functor Action where
|
instance Functor Action where
|
||||||
fmap f (Parent a ds) = Parent (f a) ds
|
fmap f (Parent a ds) = Parent (f a) ds
|
||||||
fmap f (Chain a b) = Chain (f . a) b
|
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
|
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
|
-- 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
|
featureEndpoint :: BusName -> ObjectPath -> InterfaceName -> MemberName
|
||||||
-> Maybe Client -> FeatureIO
|
-> Maybe Client -> FeatureIO
|
||||||
featureEndpoint busname path iface mem client = Feature
|
featureEndpoint busname path iface mem client = Feature
|
||||||
{ ftrMaybeAction = DBusEndpoint_ cmd busname client deps []
|
{ ftrMaybeAction = DBusEndpoint_ cmd client deps []
|
||||||
, ftrName = "screensaver toggle"
|
, ftrName = "screensaver toggle"
|
||||||
, ftrWarning = Default
|
, ftrWarning = Default
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
cmd = \c -> void $ callMethod c busname path iface mem
|
cmd = \c -> void $ callMethod c busname path iface mem
|
||||||
deps = [Endpoint path iface $ Method_ mem]
|
deps = [Endpoint busname path iface $ Method_ mem]
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Feature evaluation
|
-- | Feature evaluation
|
||||||
|
@ -151,9 +150,9 @@ evalAction (Parent a ds) = do
|
||||||
|
|
||||||
evalAction (Chain a b) = second a <$> b
|
evalAction (Chain a b) = second a <$> b
|
||||||
|
|
||||||
evalAction (DBusEndpoint_ _ _ Nothing _ _) = return $ Left ["client not available"]
|
evalAction (DBusEndpoint_ _ Nothing _ _) = return $ Left ["client not available"]
|
||||||
evalAction (DBusEndpoint_ action busname (Just client) es ds) = do
|
evalAction (DBusEndpoint_ action (Just client) es ds) = do
|
||||||
eperrors <- mapM (endpointSatisfied client busname) es
|
eperrors <- mapM (endpointSatisfied client) es
|
||||||
dperrors <- mapM evalDependency ds
|
dperrors <- mapM evalDependency ds
|
||||||
return $ case catMaybes (eperrors ++ dperrors) of
|
return $ case catMaybes (eperrors ++ dperrors) of
|
||||||
[] -> Right $ action client
|
[] -> Right $ action client
|
||||||
|
@ -167,34 +166,6 @@ evalAction (DBusBus_ action busname (Just client) deps) = do
|
||||||
[] -> Right $ action client
|
[] -> Right $ action client
|
||||||
es' -> Left es'
|
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 :: Feature a -> IO (MaybeAction a)
|
||||||
evalFeature (ConstFeature x) = return $ Right x
|
evalFeature (ConstFeature x) = return $ Right x
|
||||||
evalFeature Feature
|
evalFeature Feature
|
||||||
|
@ -246,9 +217,7 @@ data DBusMember = Method_ MemberName
|
||||||
| Property_ String
|
| Property_ String
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Bus = Bus Bool BusName deriving (Eq, Show)
|
data Endpoint = Endpoint BusName ObjectPath InterfaceName DBusMember deriving (Eq, Show)
|
||||||
|
|
||||||
data Endpoint = Endpoint ObjectPath InterfaceName DBusMember deriving (Eq, Show)
|
|
||||||
|
|
||||||
pathR :: String -> Dependency
|
pathR :: String -> Dependency
|
||||||
pathR n = AccessiblePath n True False
|
pathR n = AccessiblePath n True False
|
||||||
|
@ -345,8 +314,8 @@ busSatisfied client bus = do
|
||||||
bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
|
bodyGetNames [v] = fromMaybe [] $ fromVariant v :: [String]
|
||||||
bodyGetNames _ = []
|
bodyGetNames _ = []
|
||||||
|
|
||||||
endpointSatisfied :: Client -> BusName -> Endpoint -> IO (Maybe String)
|
endpointSatisfied :: Client -> Endpoint -> IO (Maybe String)
|
||||||
endpointSatisfied client busname (Endpoint objpath iface mem) = do
|
endpointSatisfied client (Endpoint busname objpath iface mem) = do
|
||||||
-- client <- if u then connectSystem else connectSession
|
-- client <- if u then connectSystem else connectSession
|
||||||
ret <- callMethod client busname objpath introspectInterface introspectMethod
|
ret <- callMethod client busname objpath introspectInterface introspectMethod
|
||||||
-- disconnect client
|
-- disconnect client
|
||||||
|
|
Loading…
Reference in New Issue