ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH use dbus lib for signals

This commit is contained in:
Nathan Dwarshuis 2023-01-02 18:21:13 -05:00
parent c1fef3c4c4
commit 8eb97f3eec
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lib/XMonad/Internal/DBus/Removable.hs
View File

@ -73,24 +73,23 @@ removedHasDrive [_, a] =
(fromVariant a :: Maybe [String]) (fromVariant a :: Maybe [String])
removedHasDrive _ = False removedHasDrive _ = False
playSoundMaybe :: FilePath -> Bool -> IO () playSoundMaybe :: MonadUnliftIO m => FilePath -> Bool -> m ()
playSoundMaybe p b = when b $ io $ playSound p playSoundMaybe p b = when b $ io $ playSound p
-- NOTE: the udisks2 service should be already running for this module to work. -- 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 -- 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 -- 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. -- enable the udisks2 service at boot; however this is not default behavior.
listenDevices :: SysClient -> IO () listenDevices :: MonadUnliftIO m => SysClient -> m ()
listenDevices cl = do listenDevices cl = do
addMatch' memAdded driveInsertedSound addedHasDrive addMatch' memAdded driveInsertedSound addedHasDrive
addMatch' memRemoved driveRemovedSound removedHasDrive addMatch' memRemoved driveRemovedSound removedHasDrive
where where
addMatch' m p f = addMatch' m p f = do
void $ let rule = ruleUdisks {matchMember = Just m}
addMatch (toClient cl) ruleUdisks {matchMember = Just m} $ void $ addMatchCallback rule (playSoundMaybe p . f) cl
playSoundMaybe p . f . signalBody
runRemovableMon :: Maybe SysClient -> SometimesIO runRemovableMon :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
runRemovableMon cl = runRemovableMon cl =
sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices sometimesDBus cl "removeable device monitor" "dbus monitor" deps $ io . listenDevices
where where