-------------------------------------------------------------------------------- -- | General commands module XMonad.Internal.Command.Desktop ( myTerm , playSound -- commands , runTerm , runTMux , runCalc , runBrowser , runEditor , runFileManager , runTogglePlay , runPrevTrack , runNextTrack , runStopPlay , runVolumeDown , runVolumeUp , runVolumeMute , runToggleBluetooth , runToggleEthernet , runRestart , runRecompile , runAreaCapture , runScreenCapture , runDesktopCapture , runCaptureBrowser , runStartISyncTimer , runStartISyncService , runNotificationClose , runNotificationCloseAll , runNotificationHistory , runNotificationContext -- daemons , runNetAppDaemon ) where import Control.Monad (void) import Control.Monad.IO.Class import DBus import DBus.Client import System.Directory import System.Environment import System.FilePath import System.Posix.User import XMonad (asks) import XMonad.Actions.Volume import XMonad.Core hiding (spawn) import XMonad.Internal.DBus.Common import XMonad.Internal.Dependency import XMonad.Internal.Notify import XMonad.Internal.Process import XMonad.Internal.Shell import XMonad.Operations -------------------------------------------------------------------------------- -- | My Executables myTerm :: String myTerm = "urxvt" myBrowser :: String myBrowser = "brave-accel" myEditor :: String myEditor = "emacsclient" myEditorServer :: String myEditorServer = "emacs" myMultimediaCtl :: String myMultimediaCtl = "playerctl" myBluetooth :: String myBluetooth = "bluetoothctl" myCapture :: String myCapture = "flameshot" myImageBrowser :: String myImageBrowser = "feh" myNotificationCtrl :: String myNotificationCtrl = "dunstctl" -------------------------------------------------------------------------------- -- | Misc constants volumeChangeSound :: FilePath volumeChangeSound = "smb_fireball.wav" -------------------------------------------------------------------------------- -- | Some nice apps runTerm :: SometimesX runTerm = sometimesExe "terminal" "urxvt" True myTerm runTMux :: SometimesX runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act where deps = listToAnds (socketExists "tmux" socketName) $ fmap sysExe [myTerm, "tmux", "bash"] act = spawn $ "tmux has-session" #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c] #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg } c = "exec tmux attach-session -d" msg = "could not connect to tmux session" socketName = do u <- getEffectiveUserID t <- getTemporaryDirectory return $ t "tmux-" ++ show u "default" runCalc :: SometimesX runCalc = sometimesIO_ "calculator" "R" deps act where deps = toAnd_ (sysExe myTerm) (sysExe "R") act = spawnCmd myTerm ["-e", "R"] runBrowser :: SometimesX runBrowser = sometimesExe "web browser" "brave" False myBrowser runEditor :: SometimesX runEditor = sometimesIO_ "text editor" "emacs" tree cmd where cmd = spawnCmd myEditor ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"] -- NOTE we could test if the emacs socket exists, but it won't come up -- before xmonad starts, so just check to see if the process has started tree = toAnd_ (sysExe myEditor) $ process myEditorServer runFileManager :: SometimesX runFileManager = sometimesExe "file browser" "pcmanfm" True "pcmanfm" -------------------------------------------------------------------------------- -- | Multimedia Commands runMultimediaIfInstalled :: String -> String -> SometimesX runMultimediaIfInstalled n cmd = sometimesExeArgs (n ++ " multimedia control") "playerctl" True myMultimediaCtl [cmd] runTogglePlay :: SometimesX runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause" runPrevTrack :: SometimesX runPrevTrack = runMultimediaIfInstalled "previous track" "previous" runNextTrack :: SometimesX runNextTrack = runMultimediaIfInstalled "next track" "next" runStopPlay :: SometimesX runStopPlay = runMultimediaIfInstalled "stop playback" "stop" -------------------------------------------------------------------------------- -- | Volume Commands soundDir :: FilePath soundDir = "sound" playSound :: MonadIO m => FilePath -> m () playSound file = do -- manually look up directories to avoid the X monad p <- io $ ( soundDir file) . cfgDir <$> getDirectories -- paplay seems to have less latency than aplay spawnCmd "paplay" [p] featureSound :: String -> FilePath -> X () -> X () -> SometimesX featureSound n file pre post = sometimesIO_ ("volume " ++ n ++ " control") "paplay" (Only_ $ sysExe "paplay") $ pre >> playSound file >> post runVolumeDown :: SometimesX runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2) runVolumeUp :: SometimesX runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2) runVolumeMute :: SometimesX runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return () -------------------------------------------------------------------------------- -- | Notification control runNotificationCmd :: String -> FilePath -> Maybe Client -> SometimesX runNotificationCmd n arg cl = sometimesDBus cl (n ++ " control") "dunstctl" tree cmd where cmd _ = spawnCmd myNotificationCtrl [arg] tree = toAnd_ (DBusIO $ sysExe myNotificationCtrl) $ Endpoint notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0") $ Method_ $ memberName_ "NotificationAction" runNotificationClose :: Maybe Client -> SometimesX runNotificationClose = runNotificationCmd "close notification" "close" runNotificationCloseAll :: Maybe Client -> SometimesX runNotificationCloseAll = runNotificationCmd "close all notifications" "close-all" runNotificationHistory :: Maybe Client -> SometimesX runNotificationHistory = runNotificationCmd "see notification history" "history-pop" runNotificationContext :: Maybe Client -> SometimesX runNotificationContext = runNotificationCmd "open notification context" "context" -------------------------------------------------------------------------------- -- | System commands -- this is required for some vpn's to work properly with network-manager runNetAppDaemon :: Maybe Client -> Sometimes (IO ProcessHandle) runNetAppDaemon cl = Sometimes "network applet" xpfVPN [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"] where tree = toAnd_ (DBusIO $ localExe "nm-applet") $ Bus networkManagerBus cmd _ = snd <$> spawnPipe "nm-applet" runToggleBluetooth :: Maybe Client -> SometimesX runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth [Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"] where tree = And_ (Only_ $ DBusIO $ sysExe myBluetooth) (Only_ $ Bus btBus) cmd _ = spawn $ myBluetooth ++ " show | grep -q \"Powered: no\"" #!&& "a=on" #!|| "a=off" #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" } runToggleEthernet :: SometimesX runToggleEthernet = sometimes1 "ethernet toggle" "nmcli" $ IORoot (spawn . cmd) $ And1 (Only readEthernet) (Only_ $ sysExe "nmcli") where -- TODO make this less noisy cmd iface = "nmcli -g GENERAL.STATE device show " ++ iface ++ " | grep -q disconnected" #!&& "a=connect" #!|| "a=disconnect" #!>> fmtCmd "nmcli" ["device", "$a", iface] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" } runStartISyncTimer :: SometimesX runStartISyncTimer = sometimesIO_ "isync timer" "mbsync timer" (Only_ $ sysdUser "mbsync.timer") $ spawn $ "systemctl --user start mbsync.timer" #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" } runStartISyncService :: SometimesX runStartISyncService = sometimesIO_ "isync" "mbsync service" (Only_ $ sysdUser "mbsync.service") $ spawn $ "systemctl --user start mbsync.service" #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync failed" } -------------------------------------------------------------------------------- -- | Configuration commands runRestart :: X () runRestart = restart "xmonad" True runRecompile :: X () runRecompile = do -- assume that the conf directory contains a valid stack project confDir <- asks (cfgDir . directories) spawnAt confDir $ fmtCmd "stack" ["install"] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" } -------------------------------------------------------------------------------- -- | Screen capture commands getCaptureDir :: IO FilePath getCaptureDir = do e <- lookupEnv "XDG_DATA_HOME" parent <- case e of Nothing -> fallback Just path | isRelative path -> fallback | otherwise -> return path let fullpath = parent "screenshots" createDirectoryIfMissing True fullpath return fullpath where fallback = ( ".local/share") <$> getHomeDirectory runFlameshot :: String -> String -> Maybe Client -> SometimesX runFlameshot n mode cl = sometimesDBus cl n myCapture tree cmd where cmd _ = spawnCmd myCapture [mode] tree = toAnd_ (DBusIO $ sysExe myCapture) $ Bus $ busName_ "org.flameshot.Flameshot" -- TODO this will steal focus from the current window (and puts it -- in the root window?) ...need to fix runAreaCapture :: Maybe Client -> SometimesX runAreaCapture = runFlameshot "screen area capture" "gui" -- myWindowCap = "screencap -w" --external script runDesktopCapture :: Maybe Client -> SometimesX runDesktopCapture = runFlameshot "fullscreen capture" "full" runScreenCapture :: Maybe Client -> SometimesX runScreenCapture = runFlameshot "screen capture" "screen" runCaptureBrowser :: SometimesX runCaptureBrowser = sometimesIO_ "screen capture browser" "feh" (Only_ $ sysExe myImageBrowser) $ do dir <- io getCaptureDir spawnCmd myImageBrowser [dir]