ENH log failures for bluetooth listeners

lib/Data/Internal/DBus.hs

@@ -28,6 +28,11 @@ module Data.Internal.DBus
   , fromSingletonVariant
   , bodyToMaybe
   , exportPair
+  , displayBusName
+  , displayObjectPath
+  , displayMemberName
+  , displayInterfaceName
+  , displayWrapQuote
   )
 where
 
@@ -200,8 +205,7 @@ matchSignalFull client b p i m = do
   case res of
     Just o -> return $ Just $ matchSignal (Just o) p i m
     Nothing -> do
-      logError $
-        "could not add signal matcher on bus " <> bus_ <> " with match: " <> match
+      logError msg
       return Nothing
   where
     bus_ = displayWrapQuote $ displayBusName b
@@ -209,11 +213,11 @@ matchSignalFull client b p i m = do
     path_ = displayWrapQuote . displayObjectPath <$> p
     mem_ = displayWrapQuote . displayMemberName <$> m
     match =
-      displayWrapQuote $
-        mconcat $
       intersperse ", " $
         mapMaybe (\(k, v) -> fmap ((k <> "=") <>) v) $
           zip ["interface", "path", "member"] [iface_, path_, mem_]
+    stem = "could not get match rule for bus " <> bus_
+    msg = if null match then stem else stem <> " where " <> mconcat match
 
 --------------------------------------------------------------------------------
 -- Properties

lib/Xmobar/Plugins/Bluetooth.hs

@@ -81,7 +81,6 @@ startAdapter is cs cb cl = do
   forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
-    -- TODO this step could fail; at least warn the user...
     void $ addAdaptorListener state dpy adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
@@ -223,6 +222,8 @@ initAdapter
   -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
+  -- TODO this could fail if the variant is something weird; the only
+  -- indication I will get is "NA"
   putPowered state $ fromSingletonVariant reply
 
 matchBTProperty
@@ -232,6 +233,31 @@ matchBTProperty
   -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
+withBTPropertyRule
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, IsVariant a)
+  => SysClient
+  -> ObjectPath
+  -> (Maybe a -> m ())
+  -> InterfaceName
+  -> T.Text
+  -> m (Maybe SignalHandler)
+withBTPropertyRule cl path update iface prop = do
+  res <- matchBTProperty cl path
+  case res of
+    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected) cl
+    Nothing -> do
+      logError $
+        "could not add listener for prop "
+          <> prop_
+          <> " on path "
+          <> path_
+      return Nothing
+  where
+    path_ = displayObjectPath path
+    prop_ = Utf8Builder $ encodeUtf8Builder prop
+    signalToUpdate = withSignalMatch update
+    matchConnected = matchPropertyChanged iface prop
+
 addAdaptorListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
   => MutableBtState
@@ -240,10 +266,9 @@ addAdaptorListener
   -> SysClient
   -> m (Maybe SignalHandler)
 addAdaptorListener state dpy adaptor sys = do
-  rule <- matchBTProperty sys adaptor
-  forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
+  withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
   where
-    procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
+    procMatch b = putPowered state b >> dpy
 
 callGetPowered
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@@ -255,9 +280,6 @@ callGetPowered adapter =
     memberName_ $
       T.unpack adaptorPowered
 
-matchPowered :: [Variant] -> SignalMatch Bool
-matchPowered = matchPropertyChanged adapterInterface adaptorPowered
-
 putPowered :: MonadUnliftIO m => MutableBtState -> Maybe Bool -> m ()
 putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 
@@ -309,13 +331,9 @@ addDeviceListener
   -> SysClient
   -> m (Maybe SignalHandler)
 addDeviceListener state dpy device sys = do
-  rule <- matchBTProperty sys device
-  forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
+  withBTPropertyRule sys device procMatch devInterface devConnected
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
-
-matchConnected :: [Variant] -> SignalMatch Bool
-matchConnected = matchPropertyChanged devInterface devConnected
+    procMatch c = updateDevice state device c >> dpy
 
 callGetConnected
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)