ENH log when bluetooth adapter not found

This commit is contained in:
Nathan Dwarshuis 2023-01-01 23:20:15 -05:00
parent 097e4e19fc
commit c29a43a024
1 changed files with 39 additions and 48 deletions

View File

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