ENH use xmonad functions for spawning processes
This commit is contained in:
parent
964ec02569
commit
0b8f79a968
|
@ -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
|
||||||
|
|
|
@ -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" }
|
||||||
|
|
||||||
|
|
|
@ -18,11 +18,9 @@ module XMonad.Internal.Notify
|
||||||
, spawnNotify
|
, spawnNotify
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Data.Maybe
|
|
||||||
|
|
||||||
import DBus.Notify
|
import DBus.Notify
|
||||||
|
|
||||||
|
import RIO
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
|
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue