322 lines
9.9 KiB
Haskell
322 lines
9.9 KiB
Haskell
--------------------------------------------------------------------------------
|
|
-- | 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
|
|
, runFlameshotDaemon
|
|
, runNotificationDaemon
|
|
) where
|
|
|
|
import Control.Monad (void)
|
|
import Control.Monad.IO.Class
|
|
|
|
import System.Directory
|
|
( createDirectoryIfMissing
|
|
, getHomeDirectory
|
|
)
|
|
import System.Environment
|
|
import System.FilePath
|
|
|
|
import XMonad (asks)
|
|
import XMonad.Actions.Volume
|
|
import XMonad.Core hiding (spawn)
|
|
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"
|
|
|
|
myMultimediaCtl :: String
|
|
myMultimediaCtl = "playerctl"
|
|
|
|
myBluetooth :: String
|
|
myBluetooth = "bluetoothctl"
|
|
|
|
myCapture :: String
|
|
myCapture = "flameshot"
|
|
|
|
myImageBrowser :: String
|
|
myImageBrowser = "feh"
|
|
|
|
myNotificationCtrl :: String
|
|
myNotificationCtrl = "dunstctl"
|
|
|
|
myNotificationDaemon :: String
|
|
myNotificationDaemon = "dunst"
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Misc constants
|
|
|
|
volumeChangeSound :: FilePath
|
|
volumeChangeSound = "smb_fireball.wav"
|
|
|
|
ethernetIface :: String
|
|
ethernetIface = "enp7s0f1"
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | Some nice apps
|
|
|
|
runTerm :: SometimesX
|
|
runTerm = sometimesExe "terminal" "urxvt" True myTerm
|
|
|
|
runTMux :: SometimesX
|
|
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
|
|
where
|
|
deps = listToAnds (sysExe myTerm) $ fmap sysExe ["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"
|
|
|
|
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 = sometimesExeArgs "text editor" "emacs" True myEditor
|
|
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
|
|
|
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
|
|
|
|
runNotificationDaemon :: Sometimes (IO ProcessHandle)
|
|
runNotificationDaemon = sometimesIO_ "notification daemon" "dunst" tree cmd
|
|
where
|
|
tree = Only_ $ sysExe myNotificationDaemon
|
|
cmd = snd <$> spawnPipe myNotificationDaemon
|
|
|
|
runNotificationCmd :: String -> FilePath -> SometimesX
|
|
runNotificationCmd n arg = sometimesIO_ (n ++ " control") "dunstctl" tree cmd
|
|
where
|
|
tree = And_ (Only_ $ IOSometimes_ runNotificationDaemon)
|
|
(Only_ $ sysExe myNotificationCtrl)
|
|
cmd = spawnCmd myNotificationCtrl [arg]
|
|
|
|
runNotificationClose :: SometimesX
|
|
runNotificationClose = runNotificationCmd "close notification" "close"
|
|
|
|
runNotificationCloseAll :: SometimesX
|
|
runNotificationCloseAll =
|
|
runNotificationCmd "close all notifications" "close-all"
|
|
|
|
runNotificationHistory :: SometimesX
|
|
runNotificationHistory =
|
|
runNotificationCmd "see notification history" "history-pop"
|
|
|
|
runNotificationContext :: SometimesX
|
|
runNotificationContext =
|
|
runNotificationCmd "open notification context" "context"
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | System commands
|
|
|
|
-- this is required for some vpn's to work properly with network-manager
|
|
runNetAppDaemon :: Sometimes (IO ProcessHandle)
|
|
runNetAppDaemon = sometimesIO_ "network applet" "NM-applet" tree cmd
|
|
where
|
|
tree = Only_ $ localExe "nm-applet"
|
|
cmd = snd <$> spawnPipe "nm-applet"
|
|
|
|
runToggleBluetooth :: SometimesX
|
|
runToggleBluetooth =
|
|
sometimesIO_ "bluetooth toggle" "bluetoothctl" (Only_ $ sysExe myBluetooth)
|
|
$ 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 = sometimesIO_ "ethernet toggle" "nmcli" (Only_ $ sysExe "nmcli")
|
|
$ spawn
|
|
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
|
#!&& "a=connect"
|
|
#!|| "a=disconnect"
|
|
#!>> fmtCmd "nmcli" ["device", "$a", ethernetIface]
|
|
#!&& 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" }
|
|
|
|
-- runRecompile :: X ()
|
|
-- runRecompile = do
|
|
-- -- assume that the conf directory contains a valid stack project
|
|
-- -- TODO this is hacky AF
|
|
-- confDir <- getXMonadDir
|
|
-- spawnCmdAt confDir "stack" ["install"]
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- | 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
|
|
|
|
runFlameshotDaemon :: Sometimes (IO ProcessHandle)
|
|
runFlameshotDaemon = sometimesIO_ "screen capture daemon" "flameshot" tree cmd
|
|
where
|
|
tree = Only_ $ sysExe myCapture
|
|
cmd = snd <$> (spawnPipe' $ (shell myCapture) { std_err = NoStream })
|
|
|
|
runFlameshot :: String -> String -> SometimesX
|
|
runFlameshot n mode = sometimesIO_ n myCapture
|
|
(Only_ $ IOSometimes_ runFlameshotDaemon) $ spawnCmd myCapture [mode]
|
|
|
|
-- TODO this will steal focus from the current window (and puts it
|
|
-- in the root window?) ...need to fix
|
|
runAreaCapture :: SometimesX
|
|
runAreaCapture = runFlameshot "screen area capture" "gui"
|
|
|
|
-- myWindowCap = "screencap -w" --external script
|
|
|
|
runDesktopCapture :: SometimesX
|
|
runDesktopCapture = runFlameshot "fullscreen capture" "full"
|
|
|
|
runScreenCapture :: SometimesX
|
|
runScreenCapture = runFlameshot "screen capture" "screen"
|
|
|
|
runCaptureBrowser :: SometimesX
|
|
runCaptureBrowser = sometimesIO_ "screen capture browser" "feh"
|
|
(Only_ $ sysExe myImageBrowser) $ do
|
|
dir <- io getCaptureDir
|
|
spawnCmd myImageBrowser [dir]
|