xmonad-config/lib/XMonad/Internal/Command/Desktop.hs

334 lines
10 KiB
Haskell
Raw Normal View History

2020-03-28 18:38:38 -04:00
--------------------------------------------------------------------------------
-- | General commands
2020-04-01 20:17:47 -04:00
module XMonad.Internal.Command.Desktop
( myTerm
2022-07-03 01:11:32 -04:00
, playSound
-- commands
2020-04-01 20:17:47 -04:00
, runTerm
2021-06-17 01:17:59 -04:00
, runTMux
2020-04-01 20:17:47 -04:00
, runCalc
, runBrowser
, runEditor
, runFileManager
, runTogglePlay
, runPrevTrack
, runNextTrack
, runStopPlay
, runVolumeDown
, runVolumeUp
, runVolumeMute
, runToggleBluetooth
2020-05-28 23:17:17 -04:00
, runToggleEthernet
2020-04-01 20:17:47 -04:00
, runRestart
, runRecompile
, runAreaCapture
, runScreenCapture
, runDesktopCapture
, runCaptureBrowser
2021-10-24 13:30:30 -04:00
, runNotificationClose
, runNotificationCloseAll
, runNotificationHistory
, runNotificationContext
2022-07-03 01:11:32 -04:00
-- daemons
, runNetAppDaemon
-- packages
, networkManagerPkgs
2020-04-01 20:17:47 -04:00
) where
import Control.Monad (void)
2021-11-20 01:15:04 -05:00
import Control.Monad.IO.Class
2020-04-01 20:17:47 -04:00
import DBus
import DBus.Client
import System.Directory
import System.Environment
import System.FilePath
import System.Posix.User
2020-03-28 18:38:38 -04:00
import XMonad (asks)
2020-03-28 18:38:38 -04:00
import XMonad.Actions.Volume
import XMonad.Core hiding (spawn)
import XMonad.Internal.DBus.Common
import XMonad.Internal.Dependency
2020-04-01 20:17:47 -04:00
import XMonad.Internal.Notify
import XMonad.Internal.Process
2021-11-20 01:15:04 -05:00
import XMonad.Internal.Shell
2020-03-28 18:38:38 -04:00
import XMonad.Operations
--------------------------------------------------------------------------------
2021-06-19 00:17:47 -04:00
-- | My Executables
2020-03-28 18:38:38 -04:00
2020-04-01 20:17:47 -04:00
myTerm :: String
myTerm = "urxvt"
myCalc :: String
myCalc = "bc"
2021-06-19 00:17:47 -04:00
myBrowser :: String
myBrowser = "brave-accel"
myEditor :: String
myEditor = "emacsclient"
myEditorServer :: String
myEditorServer = "emacs"
2021-06-19 00:17:47 -04:00
myMultimediaCtl :: String
myMultimediaCtl = "playerctl"
myBluetooth :: String
myBluetooth = "bluetoothctl"
myCapture :: String
myCapture = "flameshot"
myImageBrowser :: String
myImageBrowser = "feh"
2021-10-24 13:30:30 -04:00
myNotificationCtrl :: String
myNotificationCtrl = "dunstctl"
--------------------------------------------------------------------------------
-- | Packages
myTermPkgs :: [Fulfillment]
myTermPkgs = [ Package True "rxvt-unicode"
, Package True "urxvt-perls"
]
myEditorPkgs :: [Fulfillment]
myEditorPkgs = [Package True "emacs-nativecomp"]
notifyPkgs :: [Fulfillment]
notifyPkgs = [Package True "dunst"]
bluetoothPkgs :: [Fulfillment]
bluetoothPkgs = [Package True "bluez-utils"]
networkManagerPkgs :: [Fulfillment]
networkManagerPkgs = [Package True "networkmanager"]
2021-06-19 00:17:47 -04:00
--------------------------------------------------------------------------------
-- | Misc constants
volumeChangeSound :: FilePath
volumeChangeSound = "smb_fireball.wav"
--------------------------------------------------------------------------------
-- | Some nice apps
runTerm :: SometimesX
runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
2021-06-19 00:17:47 -04:00
runTMux :: SometimesX
2022-07-02 17:09:21 -04:00
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
2021-06-17 01:17:59 -04:00
where
deps = listToAnds (socketExists "tmux" [] socketName)
$ fmap (sysExe myTermPkgs) [myTerm, "tmux", "bash"]
act = spawn
2021-06-19 00:17:47 -04:00
$ "tmux has-session"
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
#!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
2021-06-17 01:17:59 -04:00
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
2022-07-02 17:09:21 -04:00
runCalc = sometimesIO_ "calculator" "R" deps act
where
deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package True "bc"] myCalc)
act = spawnCmd myTerm ["-e", myCalc, "-l"]
2020-03-28 18:38:38 -04:00
runBrowser :: SometimesX
runBrowser = sometimesExe "web browser" "brave" [Package False "brave-bin"]
False myBrowser
2020-03-28 18:38:38 -04:00
runEditor :: SometimesX
runEditor = sometimesIO_ "text editor" "emacs" tree cmd
where
cmd = spawnCmd myEditor
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
-- NOTE 1: 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 myEditorPkgs myEditor) $ process [] myEditorServer
2020-03-28 18:38:38 -04:00
runFileManager :: SometimesX
runFileManager = sometimesExe "file browser" "pcmanfm" [Package True "pcmanfm"]
True "pcmanfm"
2020-03-28 18:38:38 -04:00
--------------------------------------------------------------------------------
-- | Multimedia Commands
runMultimediaIfInstalled :: String -> String -> SometimesX
2022-06-28 23:27:55 -04:00
runMultimediaIfInstalled n cmd = sometimesExeArgs (n ++ " multimedia control")
"playerctl" [Package True "playerctl"] True myMultimediaCtl [cmd]
2020-03-28 18:38:38 -04:00
runTogglePlay :: SometimesX
runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
2020-03-28 18:38:38 -04:00
runPrevTrack :: SometimesX
runPrevTrack = runMultimediaIfInstalled "previous track" "previous"
2020-03-28 18:38:38 -04:00
runNextTrack :: SometimesX
runNextTrack = runMultimediaIfInstalled "next track" "next"
2020-03-28 18:38:38 -04:00
runStopPlay :: SometimesX
runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
2020-03-28 18:38:38 -04:00
2021-11-20 01:15:04 -05:00
--------------------------------------------------------------------------------
-- | Volume Commands
soundDir :: FilePath
soundDir = "sound"
playSound :: MonadIO m => FilePath -> m ()
playSound file = do
2022-03-05 18:18:16 -05:00
-- manually look up directories to avoid the X monad
p <- io $ (</> soundDir </> file) . cfgDir <$> getDirectories
2021-11-20 01:15:04 -05:00
-- paplay seems to have less latency than aplay
spawnCmd "paplay" [p]
2020-05-31 20:56:57 -04:00
featureSound :: String -> FilePath -> X () -> X () -> SometimesX
featureSound n file pre post =
sometimesIO_ ("volume " ++ n ++ " control") "paplay" tree
2021-11-20 01:15:04 -05:00
$ pre >> playSound file >> post
where
tree = Only_ $ sysExe [Package True "libpulse"] "paplay"
2020-03-28 18:38:38 -04:00
runVolumeDown :: SometimesX
runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2)
2021-11-20 01:15:04 -05:00
runVolumeUp :: SometimesX
runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2)
2021-11-20 01:15:04 -05:00
runVolumeMute :: SometimesX
runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
2020-03-28 18:38:38 -04:00
2021-10-24 13:30:30 -04:00
--------------------------------------------------------------------------------
-- | Notification control
runNotificationCmd :: String -> FilePath -> Maybe Client -> SometimesX
runNotificationCmd n arg cl =
sometimesDBus cl (n ++ " control") "dunstctl" tree cmd
2022-07-03 01:11:32 -04:00
where
cmd _ = spawnCmd myNotificationCtrl [arg]
tree = toAnd_ (DBusIO $ sysExe notifyPkgs myNotificationCtrl)
$ Endpoint [] notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0")
$ Method_ $ memberName_ "NotificationAction"
2021-10-24 13:30:30 -04:00
runNotificationClose :: Maybe Client -> SometimesX
runNotificationClose = runNotificationCmd "close notification" "close"
2021-10-24 13:30:30 -04:00
runNotificationCloseAll :: Maybe Client -> SometimesX
runNotificationCloseAll =
runNotificationCmd "close all notifications" "close-all"
2021-10-24 13:30:30 -04:00
runNotificationHistory :: Maybe Client -> SometimesX
runNotificationHistory =
runNotificationCmd "see notification history" "history-pop"
2021-10-24 13:30:30 -04:00
runNotificationContext :: Maybe Client -> SometimesX
runNotificationContext =
runNotificationCmd "open notification context" "context"
2021-10-24 13:30:30 -04:00
2020-03-28 18:38:38 -04:00
--------------------------------------------------------------------------------
-- | System commands
2022-07-03 01:11:32 -04:00
-- this is required for some vpn's to work properly with network-manager
2022-07-08 00:21:05 -04:00
runNetAppDaemon :: Maybe Client -> Sometimes (IO ProcessHandle)
runNetAppDaemon cl = Sometimes "network applet" xpfVPN
[Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
2022-07-03 01:11:32 -04:00
where
tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
app = DBusIO $ sysExe [Package True "network-manager-applet"] "nm-applet"
2022-07-08 00:21:05 -04:00
cmd _ = snd <$> spawnPipe "nm-applet"
2022-07-03 01:11:32 -04:00
runToggleBluetooth :: Maybe Client -> SometimesX
runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
[Subfeature (DBusRoot_ cmd tree cl) "bluetoothctl"]
where
tree = And_ (Only_ $ DBusIO $ sysExe bluetoothPkgs 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" }
2020-03-28 18:38:38 -04:00
runToggleEthernet :: SometimesX
runToggleEthernet = sometimes1 "ethernet toggle" "nmcli" $ IORoot (spawn . cmd) $
And1 (Only readEthernet) (Only_ $ sysExe networkManagerPkgs "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" }
2020-05-28 23:17:17 -04:00
2020-03-28 18:38:38 -04:00
--------------------------------------------------------------------------------
-- | Configuration commands
runRestart :: X ()
runRestart = restart "xmonad" True
runRecompile :: X ()
runRecompile = do
-- assume that the conf directory contains a valid stack project
2022-03-05 18:18:16 -05:00
confDir <- asks (cfgDir . directories)
spawnAt confDir $ fmtCmd "stack" ["install"]
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
2020-04-01 20:17:47 -04:00
--------------------------------------------------------------------------------
-- | 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
2020-04-01 20:17:47 -04:00
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 [Package True "flameshot"] myCapture)
$ Bus [] $ busName_ "org.flameshot.Flameshot"
2020-04-01 20:17:47 -04:00
-- 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"
2020-04-01 20:17:47 -04:00
-- myWindowCap = "screencap -w" --external script
runDesktopCapture :: Maybe Client -> SometimesX
runDesktopCapture = runFlameshot "fullscreen capture" "full"
runScreenCapture :: Maybe Client -> SometimesX
runScreenCapture = runFlameshot "screen capture" "screen"
2021-06-19 00:54:01 -04:00
runCaptureBrowser :: SometimesX
2022-07-02 17:09:21 -04:00
runCaptureBrowser = sometimesIO_ "screen capture browser" "feh"
(Only_ $ sysExe [Package True "feh"] myImageBrowser) $ do
dir <- io getCaptureDir
2021-06-19 00:17:47 -04:00
spawnCmd myImageBrowser [dir]