ENH turn all daemons into features

This commit is contained in:
Nathan Dwarshuis 2022-07-03 01:11:32 -04:00
parent 129222c7e6
commit f82e1bd032
5 changed files with 113 additions and 23 deletions

View File

@ -87,12 +87,19 @@ run :: IO ()
run = do run = do
db <- connectXDBus db <- connectXDBus
(h, p) <- spawnPipe "xmobar" (h, p) <- spawnPipe "xmobar"
ps <- catMaybes <$> mapM executeSometimes [ runNetAppDaemon
, runFlameshotDaemon
, runNotificationDaemon
, runBwDaemon
, runClipManager
, runAutolock
]
void $ executeSometimes $ runRemovableMon $ dbSystemClient db void $ executeSometimes $ runRemovableMon $ dbSystemClient db
dws <- allDWs dws <- allDWs
forkIO_ $ void $ executeSometimes runPowermon forkIO_ $ void $ executeSometimes runPowermon
forkIO_ $ runWorkspaceMon dws forkIO_ $ runWorkspaceMon dws
let ts = ThreadState let ts = ThreadState
{ tsChildPIDs = [p] { tsChildPIDs = p:ps
, tsChildHandles = [h] , tsChildHandles = [h]
} }
fb <- evalAlways T.defFont fb <- evalAlways T.defFont

View File

@ -13,6 +13,10 @@ module XMonad.Internal.Command.DMenu
, runBTMenu , runBTMenu
, runShowKeys , runShowKeys
, runAutorandrMenu , runAutorandrMenu
-- daemons
, runBwDaemon
, runClipManager
) where ) where
import Control.Monad.Reader import Control.Monad.Reader
@ -53,6 +57,9 @@ myDmenuMonitors = "rofi-autorandr"
myDmenuNetworks :: String myDmenuNetworks :: String
myDmenuNetworks = "networkmanager_dmenu" myDmenuNetworks = "networkmanager_dmenu"
myClipboardManager :: String
myClipboardManager = "greenclip"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Other internal functions -- | Other internal functions
@ -86,10 +93,6 @@ runBTMenu :: SometimesX
runBTMenu = sometimesExeArgs "bluetooth selector" "rofi bluetooth" False runBTMenu = sometimesExeArgs "bluetooth selector" "rofi bluetooth" False
myDmenuBluetooth $ "-c":themeArgs "#0044bb" myDmenuBluetooth $ "-c":themeArgs "#0044bb"
runBwMenu :: SometimesX
runBwMenu = sometimesIO_ "password manager" "rofi bitwarden"
(Only_ $ localExe myDmenuPasswords) $ spawnCmd myDmenuPasswords
$ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
runVPNMenu :: SometimesX runVPNMenu :: SometimesX
runVPNMenu = sometimesIO_ "VPN selector" "rofi VPN" runVPNMenu = sometimesIO_ "VPN selector" "rofi VPN"
@ -102,16 +105,6 @@ runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
runAppMenu :: SometimesX runAppMenu :: SometimesX
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"] runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
runClipMenu :: SometimesX
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" deps act
where
act = spawnCmd myDmenuCmd args
deps = toAnd (sysExe myDmenuCmd) (sysExe "greenclip")
args = [ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
] ++ themeArgs "#00c44e"
runWinMenu :: SometimesX runWinMenu :: SometimesX
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"] runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
@ -123,6 +116,39 @@ runAutorandrMenu :: SometimesX
runAutorandrMenu = sometimesExeArgs "autorandr menu" "rofi autorandr" runAutorandrMenu = sometimesExeArgs "autorandr menu" "rofi autorandr"
True myDmenuMonitors $ themeArgs "#ff0066" True myDmenuMonitors $ themeArgs "#ff0066"
--------------------------------------------------------------------------------
-- | Password manager
runBwDaemon :: Sometimes (IO ProcessHandle)
runBwDaemon = sometimesIO_ "password manager daemon" "rofi bitwarden" tree cmd
where
tree = Only_ $ localExe myDmenuPasswords
cmd = snd <$> spawnPipeArgs "rofi-bw" ["-d", "3600"]
runBwMenu :: SometimesX
runBwMenu = sometimesIO_ "password manager" "rofi bitwarden"
(Only_ $ IOSometimes_ runBwDaemon) $ spawnCmd myDmenuPasswords
$ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
--------------------------------------------------------------------------------
-- | Clipboard
runClipManager :: Sometimes (IO ProcessHandle)
runClipManager = sometimesIO_ "clipboard daemon" "greenclip" tree cmd
where
tree = Only_ $ sysExe myClipboardManager
cmd = snd <$> spawnPipeArgs "greenclip" ["daemon"]
runClipMenu :: SometimesX
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
where
act = spawnCmd myDmenuCmd args
tree = toAnd (sysExe myDmenuCmd) $ IOSometimes_ runClipManager
args = [ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
] ++ themeArgs "#00c44e"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Shortcut menu -- | Shortcut menu

View File

@ -3,6 +3,9 @@
module XMonad.Internal.Command.Desktop module XMonad.Internal.Command.Desktop
( myTerm ( myTerm
, playSound
-- commands
, runTerm , runTerm
, runTMux , runTMux
, runCalc , runCalc
@ -30,7 +33,11 @@ module XMonad.Internal.Command.Desktop
, runNotificationCloseAll , runNotificationCloseAll
, runNotificationHistory , runNotificationHistory
, runNotificationContext , runNotificationContext
, playSound
-- daemons
, runNetAppDaemon
, runFlameshotDaemon
, runNotificationDaemon
) where ) where
import Control.Monad (void) import Control.Monad (void)
@ -79,6 +86,9 @@ myImageBrowser = "feh"
myNotificationCtrl :: String myNotificationCtrl :: String
myNotificationCtrl = "dunstctl" myNotificationCtrl = "dunstctl"
myNotificationDaemon :: String
myNotificationDaemon = "dunst"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Misc constants -- | Misc constants
@ -170,9 +180,18 @@ runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Notification control -- | 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 :: String -> FilePath -> SometimesX
runNotificationCmd n cmd = runNotificationCmd n arg = sometimesIO_ (n ++ " control") "dunstctl" tree cmd
sometimesExeArgs (n ++ " control") "dunst" True myNotificationCtrl [cmd] where
tree = And_ (Only_ $ IOSometimes_ runNotificationDaemon)
(Only_ $ sysExe myNotificationCtrl)
cmd = spawnCmd myNotificationCtrl [arg]
runNotificationClose :: SometimesX runNotificationClose :: SometimesX
runNotificationClose = runNotificationCmd "close notification" "close" runNotificationClose = runNotificationCmd "close notification" "close"
@ -192,6 +211,13 @@ runNotificationContext =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | System commands -- | 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 :: SometimesX
runToggleBluetooth = runToggleBluetooth =
sometimesIO_ "bluetooth toggle" "bluetoothctl" (Only_ $ sysExe myBluetooth) sometimesIO_ "bluetooth toggle" "bluetoothctl" (Only_ $ sysExe myBluetooth)
@ -265,9 +291,15 @@ getCaptureDir = do
where where
fallback = (</> ".local/share") <$> getHomeDirectory 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 :: String -> String -> SometimesX
runFlameshot n mode = sometimesIO_ n "flameshot" (Only_ $ sysExe myCapture) runFlameshot n mode = sometimesIO_ n myCapture
$ spawnCmd myCapture [mode] (Only_ $ IOSometimes_ runFlameshotDaemon) $ spawnCmd myCapture [mode]
-- TODO this will steal focus from the current window (and puts it -- TODO this will steal focus from the current window (and puts it
-- in the root window?) ...need to fix -- in the root window?) ...need to fix

View File

@ -2,6 +2,7 @@
-- | Commands for controlling power -- | Commands for controlling power
module XMonad.Internal.Command.Power module XMonad.Internal.Command.Power
-- commands
( runHibernate ( runHibernate
, runOptimusPrompt , runOptimusPrompt
, runPowerOff , runPowerOff
@ -11,6 +12,11 @@ module XMonad.Internal.Command.Power
, runSuspend , runSuspend
, runSuspendPrompt , runSuspendPrompt
, runQuitPrompt , runQuitPrompt
-- daemons
, runAutolock
-- functions
, hasBattery , hasBattery
, suspendPrompt , suspendPrompt
, quitPrompt , quitPrompt
@ -28,9 +34,11 @@ import System.Directory
import System.Exit import System.Exit
import System.FilePath.Posix import System.FilePath.Posix
import System.IO.Error import System.IO.Error
import System.Process (ProcessHandle)
import XMonad.Core import XMonad.Core
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
import XMonad.Internal.Process (spawnPipeArgs)
import XMonad.Internal.Shell import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T import qualified XMonad.Internal.Theme as T
import XMonad.Prompt import XMonad.Prompt
@ -66,6 +74,15 @@ runHibernate = spawn "systemctl hibernate"
runReboot :: X () runReboot :: X ()
runReboot = spawn "systemctl reboot" runReboot = spawn "systemctl reboot"
--------------------------------------------------------------------------------
-- | Autolock
runAutolock :: Sometimes (IO ProcessHandle)
runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
where
tree = And_ (Only_ $ sysExe "xss-lock") (Only_ $ IOSometimes_ runScreenLock)
cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Confirmation prompts -- | Confirmation prompts

View File

@ -4,7 +4,9 @@
module XMonad.Internal.Process module XMonad.Internal.Process
( waitUntilExit ( waitUntilExit
, killHandle , killHandle
, spawnPipe'
, spawnPipe , spawnPipe
, spawnPipeArgs
, createProcess' , createProcess'
, readCreateProcessWithExitCode' , readCreateProcessWithExitCode'
, proc' , proc'
@ -76,9 +78,15 @@ spawn = io . void . createProcess' . shell'
spawnAt :: MonadIO m => FilePath -> String -> m () spawnAt :: MonadIO m => FilePath -> String -> m ()
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp } spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
spawnPipe :: String -> IO (Handle, ProcessHandle) spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle)
spawnPipe cmd = do spawnPipe' cp = do
-- ASSUME creating a pipe will always succeed in making a Just Handle -- ASSUME creating a pipe will always succeed in making a Just Handle
(Just h, _, _, p) <- createProcess' $ (shell cmd) { std_in = CreatePipe } (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
hSetBuffering h LineBuffering hSetBuffering h LineBuffering
return (h, p) return (h, p)
spawnPipe :: String -> IO (Handle, ProcessHandle)
spawnPipe = spawnPipe' . shell
spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
spawnPipeArgs cmd = spawnPipe' . proc cmd