REF clean up state functions in bluetooth

This commit is contained in:
Nathan Dwarshuis 2023-01-01 23:09:23 -05:00
parent 37f607d817
commit 097e4e19fc
1 changed files with 15 additions and 18 deletions

View File

@ -157,6 +157,11 @@ readState = do
c <- readDevices c <- readDevices
return (p, anyDevicesConnected c) return (p, anyDevicesConnected c)
modifyState :: (BtState -> BTIO (BtState, a)) -> BTIO a
modifyState f = do
m <- asks btState
modifyMVar m f
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Object manager -- Object manager
@ -281,9 +286,7 @@ callGetPowered adapter =
T.unpack adaptorPowered T.unpack adaptorPowered
putPowered :: Maybe Bool -> BTIO () putPowered :: Maybe Bool -> BTIO ()
putPowered ds = do putPowered ds = modifyState $ \s -> return (s {btPowered = ds}, ())
m <- asks btState
modifyMVar_ m (\s -> return s {btPowered = ds})
readPowered :: BTIO (Maybe Bool) readPowered :: BTIO (Maybe Bool)
readPowered = fmap btPowered $ readMVar =<< asks btState readPowered = fmap btPowered $ readMVar =<< asks btState
@ -334,16 +337,12 @@ callGetConnected p =
memberName_ (T.unpack devConnected) memberName_ (T.unpack devConnected)
insertDevice :: ObjectPath -> BTDevice -> BTIO Bool insertDevice :: ObjectPath -> BTDevice -> BTIO Bool
insertDevice device dev = do insertDevice device dev = modifyState $ \s -> do
m <- asks btState
modifyMVar m $ \s -> do
let new = M.insert device dev $ btDevices s let new = M.insert device dev $ btDevices s
return (s {btDevices = new}, anyDevicesConnected new) return (s {btDevices = new}, anyDevicesConnected new)
updateDevice :: ObjectPath -> Maybe Bool -> BTIO Bool updateDevice :: ObjectPath -> Maybe Bool -> BTIO Bool
updateDevice device status = do updateDevice device status = modifyState $ \s -> do
m <- asks btState
modifyMVar m $ \s -> do
let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
return (s {btDevices = new}, anyDevicesConnected new) return (s {btDevices = new}, anyDevicesConnected new)
@ -351,9 +350,7 @@ anyDevicesConnected :: ConnectedDevices -> Bool
anyDevicesConnected = or . mapMaybe btDevConnected . M.elems anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
removeDevice :: ObjectPath -> BTIO (Maybe BTDevice) removeDevice :: ObjectPath -> BTIO (Maybe BTDevice)
removeDevice device = do removeDevice device = modifyState $ \s -> do
m <- asks btState
modifyMVar m $ \s -> do
let devs = btDevices s let devs = btDevices s
return (s {btDevices = M.delete device devs}, M.lookup device devs) return (s {btDevices = M.delete device devs}, M.lookup device devs)