ENH log when bluetooth adapter not found
This commit is contained in:
parent
097e4e19fc
commit
c29a43a024
|
@ -76,22 +76,21 @@ startAdapter
|
|||
startAdapter is cs cb cl = do
|
||||
state <- newMVar emptyState
|
||||
let dpy = displayIcon cb (iconFormatter is cs)
|
||||
mapRIO (wrap state) $ do
|
||||
mapRIO (BTEnv state dpy) $ do
|
||||
ot <- getBtObjectTree cl
|
||||
-- TODO if this fails it won't be logged
|
||||
forM_ (findAdapter ot) $ \adapter -> do
|
||||
-- set up adapter
|
||||
initAdapter adapter cl
|
||||
void $ addAdaptorListener dpy adapter cl
|
||||
-- set up devices on the adapter (and listeners for adding/removing devices)
|
||||
let devices = findDevices adapter ot
|
||||
addDeviceAddedListener dpy adapter cl
|
||||
addDeviceRemovedListener dpy adapter cl
|
||||
forM_ devices $ \d -> addAndInitDevice dpy d cl
|
||||
-- after setting things up, show the icon based on the initialized state
|
||||
dpy
|
||||
where
|
||||
wrap s env = BTEnv {btEnv = env, btState = s}
|
||||
case findAdapter ot of
|
||||
Nothing -> logError "could not find bluetooth adapter"
|
||||
Just adapter -> do
|
||||
-- set up adapter
|
||||
initAdapter adapter cl
|
||||
void $ addAdaptorListener adapter cl
|
||||
-- set up devices on the adapter (and listeners for adding/removing devices)
|
||||
let devices = findDevices adapter ot
|
||||
addDeviceAddedListener adapter cl
|
||||
addDeviceRemovedListener adapter cl
|
||||
forM_ devices $ \d -> addAndInitDevice d cl
|
||||
-- after setting things up, show the icon based on the initialized state
|
||||
dpy
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Icon Display
|
||||
|
@ -123,8 +122,9 @@ iconFormatter (iconConn, iconDisc) cs powered connected =
|
|||
-- an MVar.
|
||||
|
||||
data BTEnv = BTEnv
|
||||
{ btEnv :: !SimpleApp
|
||||
, btState :: !(MVar BtState)
|
||||
{ btState :: !(MVar BtState)
|
||||
, btDisplay :: !(BTIO ())
|
||||
, btEnv :: !SimpleApp
|
||||
}
|
||||
|
||||
instance HasLogFunc BTEnv where
|
||||
|
@ -195,30 +195,25 @@ addBtOMListener
|
|||
-> m ()
|
||||
addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
|
||||
|
||||
addDeviceAddedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
|
||||
addDeviceAddedListener dpy adapter client =
|
||||
addBtOMListener addDevice client
|
||||
addDeviceAddedListener :: ObjectPath -> SysClient -> BTIO ()
|
||||
addDeviceAddedListener adapter client = addBtOMListener addDevice client
|
||||
where
|
||||
addDevice = pathCallback adapter dpy $ \d ->
|
||||
addAndInitDevice dpy d client
|
||||
addDevice = pathCallback adapter $ \d ->
|
||||
addAndInitDevice d client
|
||||
|
||||
addDeviceRemovedListener :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
|
||||
addDeviceRemovedListener dpy adapter sys =
|
||||
addDeviceRemovedListener :: ObjectPath -> SysClient -> BTIO ()
|
||||
addDeviceRemovedListener adapter sys =
|
||||
addBtOMListener remDevice sys
|
||||
where
|
||||
remDevice = pathCallback adapter dpy $ \d -> do
|
||||
remDevice = pathCallback adapter $ \d -> do
|
||||
old <- removeDevice d
|
||||
forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
|
||||
|
||||
pathCallback
|
||||
:: MonadUnliftIO m
|
||||
=> ObjectPath
|
||||
-> m ()
|
||||
-> (ObjectPath -> m ())
|
||||
-> SignalCallback m
|
||||
pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
|
||||
pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
|
||||
pathCallback adapter f [device, _] = forM_ (fromVariant device) $ \d -> do
|
||||
dpy <- asks btDisplay
|
||||
when (adaptorHasDevice adapter d) $ f d >> dpy
|
||||
pathCallback _ _ _ _ = return ()
|
||||
pathCallback _ _ _ = return ()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Adapter
|
||||
|
@ -265,15 +260,11 @@ withBTPropertyRule cl path update iface prop = do
|
|||
signalToUpdate = withSignalMatch update
|
||||
matchConnected = matchPropertyChanged iface prop
|
||||
|
||||
addAdaptorListener
|
||||
:: BTIO ()
|
||||
-> ObjectPath
|
||||
-> SysClient
|
||||
-> BTIO (Maybe SignalHandler)
|
||||
addAdaptorListener dpy adaptor sys = do
|
||||
addAdaptorListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
|
||||
addAdaptorListener adaptor sys = do
|
||||
dpy <- asks btDisplay
|
||||
let procMatch b = putPowered b >> dpy
|
||||
withBTPropertyRule sys adaptor procMatch adapterInterface adaptorPowered
|
||||
where
|
||||
procMatch b = putPowered b >> dpy
|
||||
|
||||
callGetPowered
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
|
@ -300,9 +291,9 @@ adaptorPowered = "Powered"
|
|||
--------------------------------------------------------------------------------
|
||||
-- Devices
|
||||
|
||||
addAndInitDevice :: BTIO () -> ObjectPath -> SysClient -> BTIO ()
|
||||
addAndInitDevice dpy device client = do
|
||||
res <- addDeviceListener dpy device client
|
||||
addAndInitDevice :: ObjectPath -> SysClient -> BTIO ()
|
||||
addAndInitDevice device client = do
|
||||
res <- addDeviceListener device client
|
||||
case res of
|
||||
Just handler -> do
|
||||
logInfo $ "initializing device at path " <> device_
|
||||
|
@ -321,11 +312,11 @@ initDevice sh device sys = do
|
|||
, btDevSigHandler = sh
|
||||
}
|
||||
|
||||
addDeviceListener :: BTIO () -> ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
|
||||
addDeviceListener dpy device sys = do
|
||||
addDeviceListener :: ObjectPath -> SysClient -> BTIO (Maybe SignalHandler)
|
||||
addDeviceListener device sys = do
|
||||
dpy <- asks btDisplay
|
||||
let procMatch c = updateDevice device c >> dpy
|
||||
withBTPropertyRule sys device procMatch devInterface devConnected
|
||||
where
|
||||
procMatch c = updateDevice device c >> dpy
|
||||
|
||||
callGetConnected
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
|
|
Loading…
Reference in New Issue