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