ENH log failures for bluetooth listeners
This commit is contained in:
parent
04a7a70747
commit
7432a8f841
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue