ENH use xmonad functions for spawning processes

This commit is contained in:
Nathan Dwarshuis 2022-12-29 14:49:06 -05:00
parent 964ec02569
commit 0b8f79a968
4 changed files with 20 additions and 30 deletions

View File

@ -17,7 +17,6 @@ module XMonad.Internal.Command.DMenu
, runAutorandrMenu , runAutorandrMenu
) where ) where
import qualified Data.ByteString.Char8 as BC
import Data.Internal.DBus import Data.Internal.DBus
import Data.Internal.Dependency import Data.Internal.Dependency
@ -25,13 +24,13 @@ import DBus
import Graphics.X11.Types import Graphics.X11.Types
import qualified RIO.ByteString.Lazy as B
import qualified RIO.Text as T import qualified RIO.Text as T
import System.Directory import System.Directory
( XdgDirectory (..) ( XdgDirectory (..)
, getXdgDirectory , getXdgDirectory
) )
import System.IO
import XMonad.Core hiding (spawn) import XMonad.Core hiding (spawn)
import XMonad.Internal.Command.Desktop import XMonad.Internal.Command.Desktop
@ -201,8 +200,9 @@ showKeysDMenu = Subfeature
} }
showKeys :: [((KeyMask, KeySym), NamedAction)] -> X () showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
showKeys kbs = io $ spawnStdin i cmd showKeys kbs = do
h <- spawnPipe cmd
io $ hPutStr h $ unlines $ showKm kbs
where where
i = B.fromStrict $ BC.pack $ unlines $ showKm kbs
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"] cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs ++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs

View File

@ -41,8 +41,6 @@ module XMonad.Internal.Command.Desktop
, networkManagerPkgs , networkManagerPkgs
) where ) where
import Control.Monad.IO.Class
import Data.Internal.DBus import Data.Internal.DBus
import Data.Internal.Dependency import Data.Internal.Dependency
@ -58,7 +56,7 @@ import System.Environment
import System.Posix.User import System.Posix.User
import XMonad.Actions.Volume import XMonad.Actions.Volume
import XMonad.Core as XC import XMonad.Core hiding (spawn)
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
import XMonad.Internal.Notify import XMonad.Internal.Notify
import XMonad.Internal.Shell as S import XMonad.Internal.Shell as S
@ -296,8 +294,9 @@ runRecompile :: X ()
runRecompile = do runRecompile = do
-- assume that the conf directory contains a valid stack project -- assume that the conf directory contains a valid stack project
confDir <- asks (cfgDir . directories) confDir <- asks (cfgDir . directories)
spawnAt confDir spawn
$ fmtCmd "stack" ["install"] $ fmtCmd "cd" [T.pack confDir]
#!&& fmtCmd "stack" ["install"]
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" } #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }

View File

@ -18,12 +18,10 @@ module XMonad.Internal.Notify
, spawnNotify , spawnNotify
) where ) where
import Control.Monad.IO.Class
import Data.Maybe
import DBus.Notify import DBus.Notify
import qualified RIO.Text as T import RIO
import qualified RIO.Text as T
import XMonad.Internal.Shell import XMonad.Internal.Shell

View File

@ -57,8 +57,7 @@ module XMonad.Internal.Shell
( fmtCmd ( fmtCmd
, spawnCmd , spawnCmd
, spawn , spawn
, spawnAt , spawnPipe
, spawnStdin
, doubleQuote , doubleQuote
, singleQuote , singleQuote
, skip , skip
@ -71,15 +70,13 @@ module XMonad.Internal.Shell
, (#!>>) , (#!>>)
) where ) where
import Control.Monad.IO.Class
import RIO import RIO
import qualified RIO.ByteString.Lazy as B import qualified RIO.Text as T
import qualified RIO.Text as T
import qualified System.Process.Typed as P import qualified System.Process.Typed as P
import qualified XMonad.Core as X import qualified XMonad.Core as X
import qualified XMonad.Util.Run as XR
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Opening subshell -- | Opening subshell
@ -95,9 +92,6 @@ addGroupSession = P.setCreateGroup True . P.setNewSession True
runProcess :: P.ProcessConfig a b c -> IO ExitCode runProcess :: P.ProcessConfig a b c -> IO ExitCode
runProcess = withDefaultSignalHandlers . P.runProcess runProcess = withDefaultSignalHandlers . P.runProcess
startProcess :: P.ProcessConfig a b c -> IO (P.Process a b c)
startProcess = withDefaultSignalHandlers . P.startProcess
shell :: T.Text -> P.ProcessConfig () () () shell :: T.Text -> P.ProcessConfig () () ()
shell = addGroupSession . P.shell . T.unpack shell = addGroupSession . P.shell . T.unpack
@ -105,14 +99,13 @@ proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args) proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
spawn :: MonadIO m => T.Text -> m () spawn :: MonadIO m => T.Text -> m ()
spawn = liftIO . void . startProcess . shell spawn = X.spawn . T.unpack
spawnAt :: MonadIO m => FilePath -> T.Text -> m () -- spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell -- spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m () spawnPipe :: MonadIO m => T.Text -> m Handle
spawnStdin i = spawnPipe = XR.spawnPipe . T.unpack
liftIO . void . startProcess . P.setStdin (P.byteStringInput i) . shell
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m () spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
spawnCmd cmd = spawn . fmtCmd cmd spawnCmd cmd = spawn . fmtCmd cmd