ENH use dbus lib for signals
This commit is contained in:
parent
c1fef3c4c4
commit
8eb97f3eec
|
@ -73,24 +73,23 @@ removedHasDrive [_, a] =
|
|||
(fromVariant a :: Maybe [String])
|
||||
removedHasDrive _ = False
|
||||
|
||||
playSoundMaybe :: FilePath -> Bool -> IO ()
|
||||
playSoundMaybe :: MonadUnliftIO m => FilePath -> Bool -> m ()
|
||||
playSoundMaybe p b = when b $ io $ playSound p
|
||||
|
||||
-- NOTE: the udisks2 service should be already running for this module to work.
|
||||
-- If it not already, we won't see any signals from the dbus until it is
|
||||
-- started (it will work after it is started however). It seems safe to simply
|
||||
-- enable the udisks2 service at boot; however this is not default behavior.
|
||||
listenDevices :: SysClient -> IO ()
|
||||
listenDevices :: MonadUnliftIO m => SysClient -> m ()
|
||||
listenDevices cl = do
|
||||
addMatch' memAdded driveInsertedSound addedHasDrive
|
||||
addMatch' memRemoved driveRemovedSound removedHasDrive
|
||||
where
|
||||
addMatch' m p f =
|
||||
void $
|
||||
addMatch (toClient cl) ruleUdisks {matchMember = Just m} $
|
||||
playSoundMaybe p . f . signalBody
|
||||
addMatch' m p f = do
|
||||
let rule = ruleUdisks {matchMember = Just m}
|
||||
void $ addMatchCallback rule (playSoundMaybe p . f) cl
|
||||
|
||||
runRemovableMon :: Maybe SysClient -> SometimesIO
|
||||
runRemovableMon :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
|
||||
runRemovableMon cl =
|
||||
sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices
|
||||
where
|
||||
|
|
Loading…
Reference in New Issue