ADD module to monitor removable drives and play super mario sounds

This commit is contained in:
Nathan Dwarshuis 2020-07-06 21:08:32 -04:00
parent 2b698f609f
commit c89bae26c1
8 changed files with 82 additions and 9 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

BIN
sound/smb_pipe.wav Normal file

Binary file not shown.

BIN
sound/smb_powerup.wav Normal file

Binary file not shown.