diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 9ebe90f..332d00d 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -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 } diff --git a/lib/XMonad/Internal/Concurrent/Removable.hs b/lib/XMonad/Internal/Concurrent/Removable.hs index bdcc5e2..39e2e1d 100644 --- a/lib/XMonad/Internal/Concurrent/Removable.hs +++ b/lib/XMonad/Internal/Concurrent/Removable.hs @@ -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 } diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index 3cc2355..895da8f 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -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) diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs index bc93167..6edf482 100644 --- a/lib/XMonad/Internal/DBus/Common.hs +++ b/lib/XMonad/Internal/DBus/Common.hs @@ -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 diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 6c2816e..28a7396 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -9,7 +9,7 @@ module XMonad.Internal.DBus.Control , getDBusClient , stopXMonadService , pathExists - , xmonadBus + -- , xmonadBus , disconnect ) where diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 7bd0d36..fd29925 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -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 diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs index 9712884..4dc9d96 100644 --- a/lib/XMonad/Internal/Dependency.hs +++ b/lib/XMonad/Internal/Dependency.hs @@ -14,7 +14,6 @@ module XMonad.Internal.Dependency , Warning(..) , Dependency(..) , UnitType(..) - , Bus(..) , Endpoint(..) , DBusMember(..) , ioFeature @@ -80,14 +79,14 @@ 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 (DBusBus_ a b c eps) = DBusBus_ (f . a) b c eps + fmap f (Parent a ds) = Parent (f a) ds + fmap f (Chain a b) = Chain (f . a) b + 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 -- loglevels @@ -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