ENH log internal dbus methods (kinda)
This commit is contained in:
parent
76011dc6d6
commit
e0913a461d
|
@ -128,8 +128,18 @@ methodCallBus b p i m =
|
|||
dbusInterface :: InterfaceName
|
||||
dbusInterface = interfaceName_ "org.freedesktop.DBus"
|
||||
|
||||
callGetNameOwner :: (MonadUnliftIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
|
||||
callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
|
||||
callGetNameOwner
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> c
|
||||
-> BusName
|
||||
-> m (Maybe BusName)
|
||||
callGetNameOwner cl name = do
|
||||
res <- callMethod' cl mc
|
||||
case res of
|
||||
Left err -> do
|
||||
logError $ Utf8Builder $ encodeUtf8Builder err
|
||||
return Nothing
|
||||
Right body -> return $ fromSingletonVariant body
|
||||
where
|
||||
mc =
|
||||
(methodCallBus dbusName dbusPath dbusInterface mem)
|
||||
|
@ -175,7 +185,7 @@ matchSignal b p i m =
|
|||
}
|
||||
|
||||
matchSignalFull
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> c
|
||||
-> BusName
|
||||
-> Maybe ObjectPath
|
||||
|
@ -213,7 +223,7 @@ matchProperty b p =
|
|||
matchSignal b p (Just propertyInterface) (Just propertySignal)
|
||||
|
||||
matchPropertyFull
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> c
|
||||
-> BusName
|
||||
-> Maybe ObjectPath
|
||||
|
@ -275,7 +285,7 @@ callGetManagedObjects cl bus path =
|
|||
<$> callMethod cl bus path omInterface getManagedObjects
|
||||
|
||||
addInterfaceChangedListener
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> BusName
|
||||
-> MemberName
|
||||
-> ObjectPath
|
||||
|
@ -287,7 +297,7 @@ addInterfaceChangedListener bus prop path sc cl = do
|
|||
forM rule $ \r -> addMatchCallback r sc cl
|
||||
|
||||
addInterfaceAddedListener
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> BusName
|
||||
-> ObjectPath
|
||||
-> SignalCallback m
|
||||
|
@ -297,7 +307,7 @@ addInterfaceAddedListener bus =
|
|||
addInterfaceChangedListener bus omInterfacesAdded
|
||||
|
||||
addInterfaceRemovedListener
|
||||
:: (MonadUnliftIO m, SafeClient c)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
|
||||
=> BusName
|
||||
-> ObjectPath
|
||||
-> SignalCallback m
|
||||
|
|
|
@ -68,7 +68,7 @@ instance Exec Bluetooth where
|
|||
withDBusClientConnection cb $ startAdapter icons colors cb
|
||||
|
||||
startAdapter
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> Icons
|
||||
-> Colors
|
||||
-> Callback
|
||||
|
@ -170,11 +170,15 @@ getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
|
|||
btOMPath :: ObjectPath
|
||||
btOMPath = objectPath_ "/"
|
||||
|
||||
addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
||||
addBtOMListener
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> SignalCallback m
|
||||
-> SysClient
|
||||
-> m ()
|
||||
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
|
||||
|
||||
addDeviceAddedListener
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> m ()
|
||||
-> ObjectPath
|
||||
|
@ -187,7 +191,7 @@ addDeviceAddedListener state dpy adapter client =
|
|||
addAndInitDevice state dpy d client
|
||||
|
||||
addDeviceRemovedListener
|
||||
:: (MonadUnliftIO m)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> m ()
|
||||
-> ObjectPath
|
||||
|
@ -219,14 +223,14 @@ initAdapter state adapter client = do
|
|||
putPowered state $ fromSingletonVariant reply
|
||||
|
||||
matchBTProperty
|
||||
:: (MonadUnliftIO m)
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> SysClient
|
||||
-> ObjectPath
|
||||
-> m (Maybe MatchRule)
|
||||
matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
|
||||
|
||||
addAdaptorListener
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> m ()
|
||||
-> ObjectPath
|
||||
|
@ -263,7 +267,7 @@ adaptorPowered = "Powered"
|
|||
-- Devices
|
||||
|
||||
addAndInitDevice
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> m ()
|
||||
-> ObjectPath
|
||||
|
@ -291,7 +295,7 @@ initDevice state sh device sys = do
|
|||
}
|
||||
|
||||
addDeviceListener
|
||||
:: MonadUnliftIO m
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> MutableBtState
|
||||
-> m ()
|
||||
-> ObjectPath
|
||||
|
|
|
@ -77,10 +77,18 @@ getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
|
|||
findTunnels :: ObjectTree -> VPNState
|
||||
findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
|
||||
|
||||
vpnAddedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
||||
vpnAddedListener
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> SignalCallback m
|
||||
-> SysClient
|
||||
-> m ()
|
||||
vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
|
||||
|
||||
vpnRemovedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
|
||||
vpnRemovedListener
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
=> SignalCallback m
|
||||
-> SysClient
|
||||
-> m ()
|
||||
vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
|
||||
|
||||
addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
|
||||
|
|
Loading…
Reference in New Issue