ENH log errors for dbus property query
This commit is contained in:
parent
e0913a461d
commit
5912e70526
|
@ -33,6 +33,7 @@ where
|
|||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
import qualified RIO.Text as T
|
||||
|
@ -205,18 +206,20 @@ propertySignal :: MemberName
|
|||
propertySignal = memberName_ "PropertiesChanged"
|
||||
|
||||
callPropertyGet
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> BusName
|
||||
-> ObjectPath
|
||||
-> InterfaceName
|
||||
-> MemberName
|
||||
-> c
|
||||
-> m [Variant]
|
||||
callPropertyGet bus path iface property cl =
|
||||
liftIO $
|
||||
fmap (either (const []) (: [])) $
|
||||
getProperty (toClient cl) $
|
||||
methodCallBus bus path iface property
|
||||
callPropertyGet bus path iface property cl = do
|
||||
res <- liftIO $ getProperty (toClient cl) $ methodCallBus bus path iface property
|
||||
case res of
|
||||
Left err -> do
|
||||
logError $ displayBytesUtf8 $ BC.pack $ methodErrorMessage err
|
||||
return []
|
||||
Right v -> return [v]
|
||||
|
||||
matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
|
||||
matchProperty b p =
|
||||
|
|
|
@ -213,7 +213,7 @@ pathCallback _ _ _ _ = return ()
|
|||
-- Adapter
|
||||
|
||||
initAdapter
|
||||
:: (MonadUnliftIO m)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> ObjectPath
|
||||
-> SysClient
|
||||
|
@ -242,7 +242,11 @@ addAdaptorListener state dpy adaptor sys = do
|
|||
where
|
||||
procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
|
||||
|
||||
callGetPowered :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
|
||||
callGetPowered
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> ObjectPath
|
||||
-> SysClient
|
||||
-> m [Variant]
|
||||
callGetPowered adapter =
|
||||
callPropertyGet btBus adapter adapterInterface $
|
||||
memberName_ $
|
||||
|
@ -279,7 +283,7 @@ addAndInitDevice state dpy device client = do
|
|||
forM_ sh $ \s -> initDevice state s device client
|
||||
|
||||
initDevice
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> SignalHandler
|
||||
-> ObjectPath
|
||||
|
@ -310,7 +314,11 @@ addDeviceListener state dpy device sys = do
|
|||
matchConnected :: [Variant] -> SignalMatch Bool
|
||||
matchConnected = matchPropertyChanged devInterface devConnected
|
||||
|
||||
callGetConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
|
||||
callGetConnected
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> ObjectPath
|
||||
-> SysClient
|
||||
-> m [Variant]
|
||||
callGetConnected p =
|
||||
callPropertyGet btBus p devInterface $
|
||||
memberName_ (T.unpack devConnected)
|
||||
|
|
|
@ -52,7 +52,11 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
|
|||
{ methodCallBody = [toVariant iface]
|
||||
}
|
||||
|
||||
getDeviceConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
|
||||
getDeviceConnected
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> ObjectPath
|
||||
-> SysClient
|
||||
-> m [Variant]
|
||||
getDeviceConnected path =
|
||||
callPropertyGet networkManagerBus path nmDeviceInterface $
|
||||
memberName_ $
|
||||
|
|
Loading…
Reference in New Issue