ENH log internal dbus methods (kinda)

This commit is contained in:
Nathan Dwarshuis 2023-01-01 19:41:46 -05:00
parent 76011dc6d6
commit e0913a461d
3 changed files with 39 additions and 17 deletions

View File

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

View File

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

View File

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