diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 0c7e542..6fe8244 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -44,6 +44,7 @@ import XMonad.Internal.Command.Power import XMonad.Internal.Concurrent.ACPIEvent import XMonad.Internal.Concurrent.ClientMessage import XMonad.Internal.Concurrent.DynamicWorkspaces +import XMonad.Internal.Concurrent.Removable import XMonad.Internal.DBus.Control import XMonad.Internal.Process import XMonad.Internal.Shell @@ -66,6 +67,7 @@ main = do cl <- startXMonadService (h, p) <- spawnPipe "xmobar" _ <- forkIO runPowermon + _ <- forkIO runRemovableMon _ <- forkIO $ runWorkspaceMon allDWs let ts = ThreadState { client = cl diff --git a/lib/XMonad/Internal/Concurrent/Removable.hs b/lib/XMonad/Internal/Concurrent/Removable.hs new file mode 100644 index 0000000..14e9e96 --- /dev/null +++ b/lib/XMonad/Internal/Concurrent/Removable.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +-------------------------------------------------------------------------------- +-- | Module for monitoring removable drive events +-- +-- Currently, its only purpose is to play Super Mario sounds when a drive is +-- inserted or removed. Why? Because I can. + +module XMonad.Internal.Concurrent.Removable (runRemovableMon) where + +import Control.Concurrent +import Control.Monad + +import Data.Map.Lazy (Map, member) +import Data.Maybe (maybe) + +import DBus +import DBus.Client + +import XMonad.Internal.Shell + +path :: ObjectPath +path = "/org/freedesktop/UDisks2" + +interface :: InterfaceName +interface = "org.freedesktop.DBus.ObjectManager" + +memAdded :: MemberName +memAdded = "InterfacesAdded" + +memRemoved :: MemberName +memRemoved = "InterfacesRemoved" + +driveInsertedSound :: FilePath +driveInsertedSound = "smb_powerup.wav" + +driveRemovedSound :: FilePath +driveRemovedSound = "smb_pipe.wav" + +ruleUdisks :: MatchRule +ruleUdisks = matchAny + { matchPath = Just path + , matchInterface = Just interface + } + +driveFlag :: String +driveFlag = "org.freedesktop.UDisks2.Drive" + +addedHasDrive :: [Variant] -> Bool +addedHasDrive [_, a] = maybe False (member driveFlag) + (fromVariant a :: Maybe (Map String (Map String Variant))) +addedHasDrive _ = False + +removedHasDrive :: [Variant] -> Bool +removedHasDrive [_, a] = maybe False (driveFlag `elem`) + (fromVariant a :: Maybe [String]) +removedHasDrive _ = False + +playSoundMaybe :: FilePath -> Bool -> IO () +playSoundMaybe p b = when b $ spawnSound p + +runRemovableMon :: IO () +runRemovableMon = do + client <- connectSystem + _ <- addMatch' client memAdded driveInsertedSound addedHasDrive + _ <- addMatch' client memRemoved driveRemovedSound removedHasDrive + forever (threadDelay 5000000) + where + addMatch' client m p f = addMatch client ruleUdisks { matchMember = Just m } + $ playSoundMaybe p . f . signalBody diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 156b482..eb48390 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -13,7 +13,6 @@ import DBus.Client import XMonad.Internal.DBus.IntelBacklight import XMonad.Internal.DBus.Screensaver --- import XMonad.Internal.DBus.Workspaces startXMonadService :: IO Client startXMonadService = do @@ -27,7 +26,6 @@ startXMonadService = do putStrLn "Started xmonad dbus client" exportIntelBacklight client exportScreensaver client - -- exportWorkspaces client return client stopXMonadService :: Client -> IO () diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs index 69f0322..de73f34 100644 --- a/lib/XMonad/Internal/Process.hs +++ b/lib/XMonad/Internal/Process.hs @@ -16,6 +16,7 @@ module XMonad.Internal.Process import Control.Concurrent import Control.Exception import Control.Monad +import Control.Monad.IO.Class import Data.Maybe @@ -25,7 +26,7 @@ import System.IO import System.Posix.Signals import System.Process -import XMonad.Core hiding (spawn) +import XMonad.Core hiding (spawn) -- | Block until a PID has exited (in any form) -- ASSUMPTION on linux PIDs will always increase until they overflow, in which @@ -64,10 +65,10 @@ shell' = addGroupSession . shell proc' :: FilePath -> [String] -> CreateProcess proc' cmd args = addGroupSession $ proc cmd args -spawn :: String -> X () +spawn :: MonadIO m => String -> m () spawn = io . void . createProcess' . shell' -spawnAt :: FilePath -> String -> X () +spawnAt :: MonadIO m => FilePath -> String -> m () spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp } spawnPipe :: String -> IO (Handle, ProcessHandle) diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index b198115..084a716 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -10,15 +10,17 @@ module XMonad.Internal.Shell , (#!>>) ) where +import Control.Monad.IO.Class + import System.FilePath.Posix -import XMonad.Core (X, getXMonadDir) +import XMonad.Core (getXMonadDir) import XMonad.Internal.Process -------------------------------------------------------------------------------- -- | Opening subshell -spawnCmd :: String -> [String] -> X () +spawnCmd :: MonadIO m => String -> [String] -> m () spawnCmd cmd args = spawn $ fmtCmd cmd args -------------------------------------------------------------------------------- @@ -27,7 +29,7 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args soundDir :: FilePath soundDir = "sound" -spawnSound :: FilePath -> X () +spawnSound :: MonadIO m => FilePath -> m () spawnSound file = do path <- ( soundDir file) <$> getXMonadDir -- paplay seems to have less latency than aplay diff --git a/my-xmonad.cabal b/my-xmonad.cabal index d154119..2ebfcb2 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -8,6 +8,7 @@ library exposed-modules: XMonad.Internal.Concurrent.ClientMessage , XMonad.Internal.Concurrent.ACPIEvent , XMonad.Internal.Concurrent.DynamicWorkspaces + , XMonad.Internal.Concurrent.Removable , XMonad.Internal.Theme , XMonad.Internal.Notify , XMonad.Internal.Shell @@ -18,7 +19,6 @@ library , XMonad.Internal.DBus.IntelBacklight , XMonad.Internal.DBus.Control , XMonad.Internal.DBus.Screensaver - , XMonad.Internal.DBus.Workspaces , XMonad.Internal.Process , Xmobar.Plugins.Bluetooth , Xmobar.Plugins.Device diff --git a/sound/smb_pipe.wav b/sound/smb_pipe.wav new file mode 100644 index 0000000..bbeec36 Binary files /dev/null and b/sound/smb_pipe.wav differ diff --git a/sound/smb_powerup.wav b/sound/smb_powerup.wav new file mode 100644 index 0000000..d085783 Binary files /dev/null and b/sound/smb_powerup.wav differ