ENH use dependencies in dbus endpoint tests

bin/xmobar.hs

@@ -274,7 +274,7 @@ rightPlugins :: Maybe Client -> Maybe Client -> IO [MaybeAction CmdSpec]
 rightPlugins sysClient sesClient = mapM evalFeature
   [ getWireless
   , getEthernet
-  , getVPN
+  , getVPN sysClient
   , getBt sysClient
   , getAlsa
   , getBattery
@@ -291,8 +291,6 @@ getWireless = Feature
   , ftrName = "wireless status indicator"
   , ftrWarning = Default
   }
-  -- i <- readInterface isWireless
-  -- return $ maybe (Left []) (Right . wirelessCmd) i
 
 -- TODO this needs a dbus interface
 getEthernet :: BarFeature
@@ -316,20 +314,19 @@ getBattery = Feature
 
 type BarFeature = Feature CmdSpec
 
-getVPN :: BarFeature
-getVPN = Feature
-  { ftrMaybeAction = Parent vpnCmd [v]
+getVPN :: Maybe Client -> BarFeature
+getVPN client = Feature
+  { ftrMaybeAction = DBusEndpoint_ (const vpnCmd) vpnBus client
+                     [Endpoint vpnPath vpnInterface $ Property_ vpnConnType]
+                     [IOTest vpnPresent]
   , ftrName = "VPN status indicator"
   , ftrWarning = Default
   }
-  where
-    -- d = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
-    v = IOTest vpnPresent
 
 getBt :: Maybe Client -> BarFeature
 getBt client = Feature
   { ftrMaybeAction = DBusEndpoint_ (const btCmd) btBus client
-                     [Endpoint btPath btInterface $ Property_ btPowered]
+                     [Endpoint btPath btInterface $ Property_ btPowered] []
   , ftrName = "bluetooth status indicator"
   , ftrWarning = Default
   }
@@ -343,21 +340,21 @@ getAlsa = Feature
 
 getBl :: Maybe Client -> BarFeature
 getBl client = Feature
-  { ftrMaybeAction = DBusEndpoint_ (const blCmd) xmonadBusName client [intelBacklightSignalDep]
+  { ftrMaybeAction = DBusEndpoint_ (const blCmd) xmonadBusName 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) xmonadBusName 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) xmonadBusName client [ssSignalDep] []
   , ftrName = "screensaver indicator"
   , ftrWarning = Default
   }

lib/XMonad/Internal/Concurrent/Removable.hs

@@ -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) bus client [addedDep, removedDep] []
   , ftrName = "removeable device monitor"
   , ftrWarning = Default
   }

lib/XMonad/Internal/Dependency.hs

@@ -9,7 +9,6 @@ module XMonad.Internal.Dependency
   ( MaybeAction
   , MaybeX
   , Parent(..)
-  -- , ConstFeature(..)
   , Chain(..)
   , DBusEndpoint_(..)
   , DBusBus_(..)
@@ -80,25 +79,21 @@ data Feature a = forall e. Evaluable e => Feature
   { ftrMaybeAction :: e a
   , ftrName        :: String
   , ftrWarning     :: Warning
-  -- , ftrChildren    :: [Dependency]
   }
   | ConstFeature a
   -- | BlankFeature
 
--- TODO this name sucks
 data Parent a = Parent a [Dependency] deriving (Functor)
 
--- newtype ConstFeature a = ConstFeature a deriving (Functor)
-
 data Chain a = forall b. Chain (b -> a) (IO (Either [String] b))
 
 instance Functor Chain where
   fmap f (Chain a b) = Chain (f . a) b
 
-data DBusEndpoint_ a = DBusEndpoint_ (Client -> a) BusName (Maybe Client) [Endpoint]
+data DBusEndpoint_ a = DBusEndpoint_ (Client -> a) BusName (Maybe Client) [Endpoint] [Dependency]
 
 instance Functor DBusEndpoint_ where
-  fmap f (DBusEndpoint_ a b c eps) = DBusEndpoint_ (f . a) b c eps
+  fmap f (DBusEndpoint_ a b c es ds) = DBusEndpoint_ (f . a) b c es ds
 
 data DBusBus_ a = DBusBus_ (Client -> a) BusName (Maybe Client) [Dependency]
 
@@ -123,11 +118,9 @@ ioFeature Feature {..} =
 
 featureDefault :: String -> [Dependency] -> a -> Feature a
 featureDefault n ds x = Feature
-  -- { ftrMaybeAction = x
   { ftrMaybeAction = Parent x ds
   , ftrName = n
   , ftrWarning = Default
-  -- , ftrChildren = ds
   }
 
 featureExe :: MonadIO m => String -> String -> Feature (m ())
@@ -140,11 +133,9 @@ featureExeArgs n cmd args =
 featureEndpoint :: BusName -> ObjectPath -> InterfaceName -> MemberName
   -> Maybe Client -> FeatureIO
 featureEndpoint busname path iface mem client = Feature
-  -- { ftrMaybeAction = cmd
-  { ftrMaybeAction = DBusEndpoint_ cmd busname client deps
+  { ftrMaybeAction = DBusEndpoint_ cmd busname client deps []
   , ftrName = "screensaver toggle"
   , ftrWarning = Default
-  -- , ftrChildren = [DBusEndpoint (Bus False busname) $ Endpoint path iface $ Method_ mem]
   }
   where
     cmd = \c -> void $ callMethod c busname path iface mem
@@ -171,17 +162,15 @@ instance Evaluable Parent where
       []  -> Right a
       es' -> Left es'
 
--- instance Evaluable ConstFeature where
---   eval (ConstFeature a) = return $ Right a
-
 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) deps) = do
-    es <- catMaybes <$> mapM (endpointSatisfied client busname) deps
-    return $ case es of
+  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'