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