ENH turn all daemons into features

bin/xmonad.hs

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

lib/XMonad/Internal/Command/DMenu.hs

@@ -13,6 +13,10 @@ module XMonad.Internal.Command.DMenu
   , runBTMenu
   , runShowKeys
   , runAutorandrMenu
+
+  -- daemons
+  , runBwDaemon
+  , runClipManager
   ) where
 
 import           Control.Monad.Reader
@@ -53,6 +57,9 @@ myDmenuMonitors = "rofi-autorandr"
 myDmenuNetworks :: String
 myDmenuNetworks = "networkmanager_dmenu"
 
+myClipboardManager :: String
+myClipboardManager = "greenclip"
+
 --------------------------------------------------------------------------------
 -- | Other internal functions
 
@@ -86,10 +93,6 @@ runBTMenu :: SometimesX
 runBTMenu = sometimesExeArgs "bluetooth selector" "rofi bluetooth" False
   myDmenuBluetooth $ "-c":themeArgs "#0044bb"
 
-runBwMenu :: SometimesX
-runBwMenu = sometimesIO_ "password manager" "rofi bitwarden"
-  (Only_ $ localExe myDmenuPasswords) $ spawnCmd myDmenuPasswords
-  $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
 
 runVPNMenu :: SometimesX
 runVPNMenu = sometimesIO_ "VPN selector" "rofi VPN"
@@ -102,16 +105,6 @@ runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
 runAppMenu :: SometimesX
 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 = spawnDmenuCmd "window switcher" ["-show", "window"]
 
@@ -123,6 +116,39 @@ runAutorandrMenu :: SometimesX
 runAutorandrMenu = sometimesExeArgs "autorandr menu" "rofi autorandr"
   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
 

lib/XMonad/Internal/Command/Desktop.hs

@@ -3,6 +3,9 @@
 
 module XMonad.Internal.Command.Desktop
   ( myTerm
+  , playSound
+
+  -- commands
   , runTerm
   , runTMux
   , runCalc
@@ -30,7 +33,11 @@ module XMonad.Internal.Command.Desktop
   , runNotificationCloseAll
   , runNotificationHistory
   , runNotificationContext
-  , playSound
+
+  -- daemons
+  , runNetAppDaemon
+  , runFlameshotDaemon
+  , runNotificationDaemon
   ) where
 
 import           Control.Monad              (void)
@@ -79,6 +86,9 @@ myImageBrowser = "feh"
 myNotificationCtrl :: String
 myNotificationCtrl = "dunstctl"
 
+myNotificationDaemon :: String
+myNotificationDaemon = "dunst"
+
 --------------------------------------------------------------------------------
 -- | Misc constants
 
@@ -170,9 +180,18 @@ 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 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 = runNotificationCmd "close notification" "close"
@@ -192,6 +211,13 @@ runNotificationContext =
 --------------------------------------------------------------------------------
 -- | 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)
@@ -265,9 +291,15 @@ getCaptureDir = do
   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 "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
 -- in the root window?) ...need to fix

lib/XMonad/Internal/Command/Power.hs

@@ -2,6 +2,7 @@
 -- | Commands for controlling power
 
 module XMonad.Internal.Command.Power
+  -- commands
   ( runHibernate
   , runOptimusPrompt
   , runPowerOff
@@ -11,6 +12,11 @@ module XMonad.Internal.Command.Power
   , runSuspend
   , runSuspendPrompt
   , runQuitPrompt
+
+  -- daemons
+  , runAutolock
+
+  -- functions
   , hasBattery
   , suspendPrompt
   , quitPrompt
@@ -28,9 +34,11 @@ import           System.Directory
 import           System.Exit
 import           System.FilePath.Posix
 import           System.IO.Error
+import           System.Process              (ProcessHandle)
 
 import           XMonad.Core
 import           XMonad.Internal.Dependency
+import           XMonad.Internal.Process     (spawnPipeArgs)
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as T
 import           XMonad.Prompt
@@ -66,6 +74,15 @@ runHibernate = spawn "systemctl hibernate"
 runReboot :: X ()
 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
 

lib/XMonad/Internal/Process.hs

@@ -4,7 +4,9 @@
 module XMonad.Internal.Process
   ( waitUntilExit
   , killHandle
+  , spawnPipe'
   , spawnPipe
+  , spawnPipeArgs
   , createProcess'
   , readCreateProcessWithExitCode'
   , proc'
@@ -76,9 +78,15 @@ spawn = io . void . createProcess' . shell'
 spawnAt :: MonadIO m => FilePath -> String -> m ()
 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
-  (Just h, _, _, p) <- createProcess' $ (shell cmd) { std_in = CreatePipe }
+  (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe }
   hSetBuffering h LineBuffering
   return (h, p)
+
+spawnPipe :: String -> IO (Handle, ProcessHandle)
+spawnPipe = spawnPipe' . shell
+
+spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle)
+spawnPipeArgs cmd = spawnPipe' . proc cmd