ENH log errors when adding signal matchers
This commit is contained in:
parent
6848fbe01f
commit
04a7a70747
|
@ -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 <> "'"
|
||||
|
|
Loading…
Reference in New Issue