ENH log failures for bluetooth listeners

This commit is contained in:
Nathan Dwarshuis 2023-01-01 21:30:07 -05:00
parent 04a7a70747
commit 7432a8f841
2 changed files with 42 additions and 20 deletions

View File

@ -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

View File

@ -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)