ENH log errors when adding signal matchers

lib/Data/Internal/DBus.hs

@@ -35,6 +35,7 @@ import DBus
 import DBus.Client
 import qualified Data.ByteString.Char8 as BC
 import RIO
+import RIO.List
 import qualified RIO.Map as M
 import qualified RIO.Text as T
 
@@ -92,7 +93,7 @@ getDBusClient' sys = do
   res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
     Left e -> do
-      logInfo $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
+      logInfo $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
       return Nothing
     Right c -> return $ Just c
 
@@ -151,6 +152,7 @@ callGetNameOwner cl name = do
 --------------------------------------------------------------------------------
 -- Variant parsing
 
+-- TODO log failures here?
 fromSingletonVariant :: IsVariant a => [Variant] -> Maybe a
 fromSingletonVariant = fromVariant <=< listToMaybe
 
@@ -193,8 +195,25 @@ matchSignalFull
   -> Maybe InterfaceName
   -> Maybe MemberName
   -> m (Maybe MatchRule)
-matchSignalFull client b p i m =
-  fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
+matchSignalFull client b p i m = do
+  res <- callGetNameOwner client b
+  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
+      return Nothing
+  where
+    bus_ = displayWrapQuote $ displayBusName b
+    iface_ = displayWrapQuote . displayInterfaceName <$> i
+    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_]
 
 --------------------------------------------------------------------------------
 -- Properties
@@ -291,9 +310,6 @@ callGetManagedObjects cl bus path = do
       return M.empty
     Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v
 
--- either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
---   <$>
-
 addInterfaceChangedListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
   => BusName
@@ -303,8 +319,22 @@ addInterfaceChangedListener
   -> c
   -> m (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
-  rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
-  forM rule $ \r -> addMatchCallback r sc cl
+  res <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
+  case res of
+    Nothing -> do
+      logError $
+        "could not add listener for property"
+          <> prop_
+          <> " at path "
+          <> path_
+          <> " on bus "
+          <> bus_
+      return Nothing
+    Just rule -> Just <$> addMatchCallback rule sc cl
+  where
+    bus_ = "'" <> displayBusName bus <> "'"
+    path_ = "'" <> displayObjectPath path <> "'"
+    prop_ = "'" <> displayMemberName prop <> "'"
 
 addInterfaceAddedListener
   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
@@ -345,4 +375,22 @@ exportPair path toIface cl = (up, down)
     down = do
       logInfo $ "removing interface: " <> path_
       liftIO $ unexport cl_ path
-    path_ = Utf8Builder $ encodeUtf8Builder $ T.pack $ formatObjectPath path
+    path_ = displayObjectPath path
+
+--------------------------------------------------------------------------------
+-- logging helpers
+
+displayBusName :: BusName -> Utf8Builder
+displayBusName = displayBytesUtf8 . BC.pack . formatBusName
+
+displayObjectPath :: ObjectPath -> Utf8Builder
+displayObjectPath = displayBytesUtf8 . BC.pack . formatObjectPath
+
+displayMemberName :: MemberName -> Utf8Builder
+displayMemberName = displayBytesUtf8 . BC.pack . formatMemberName
+
+displayInterfaceName :: InterfaceName -> Utf8Builder
+displayInterfaceName = displayBytesUtf8 . BC.pack . formatInterfaceName
+
+displayWrapQuote :: Utf8Builder -> Utf8Builder
+displayWrapQuote x = "'" <> x <> "'"