REF move bus to endpoint type

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
   }

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
   }

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)

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

lib/XMonad/Internal/DBus/Control.hs

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

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

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