xmonad-config/lib/XMonad/Internal/Shell.hs

107 lines
2.7 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- | Functions for formatting and spawning shell commands
module XMonad.Internal.Shell
( fmtCmd
, spawnCmd
, spawn
, spawnAt
, spawnStdin
, doubleQuote
, singleQuote
, skip
, runProcess
, proc
, shell
, (#!&&)
, (#!||)
, (#!|)
, (#!>>)
) where
import Control.Monad.IO.Class
import RIO
import qualified RIO.ByteString.Lazy as B
import qualified RIO.Text as T
import qualified System.Process.Typed as P
import qualified XMonad.Core as X
--------------------------------------------------------------------------------
-- | Opening subshell
-- https://github.com/xmonad/xmonad/issues/113
withDefaultSignalHandlers :: IO a -> IO a
withDefaultSignalHandlers =
bracket_ X.uninstallSignalHandlers X.installSignalHandlers
addGroupSession :: P.ProcessConfig x y z -> P.ProcessConfig x y z
addGroupSession = P.setCreateGroup True . P.setNewSession True
runProcess :: P.ProcessConfig a b c -> IO ExitCode
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 = addGroupSession . P.shell . T.unpack
proc :: FilePath -> [T.Text] -> P.ProcessConfig () () ()
proc cmd args = addGroupSession $ P.proc cmd (T.unpack <$> args)
spawn :: MonadIO m => T.Text -> m ()
spawn = liftIO . void . startProcess . shell
spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
spawnAt fp = liftIO . void . startProcess . P.setWorkingDir fp . shell
spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m ()
spawnStdin i =
liftIO . void . startProcess . P.setStdin (P.byteStringInput i) . shell
spawnCmd :: MonadIO m => FilePath -> [T.Text] -> m ()
spawnCmd cmd = spawn . fmtCmd cmd
--------------------------------------------------------------------------------
-- | Formatting commands
fmtCmd :: FilePath -> [T.Text] -> T.Text
fmtCmd cmd args = T.unwords $ T.pack cmd : args
op :: T.Text -> T.Text -> T.Text -> T.Text
op a x b = T.unwords [a, x, b]
(#!&&) :: T.Text -> T.Text -> T.Text
cmdA #!&& cmdB = op cmdA "&&" cmdB
infixr 0 #!&&
(#!|) :: T.Text -> T.Text -> T.Text
cmdA #!| cmdB = op cmdA "|" cmdB
infixr 0 #!|
(#!||) :: T.Text -> T.Text -> T.Text
cmdA #!|| cmdB = op cmdA "||" cmdB
infixr 0 #!||
(#!>>) :: T.Text -> T.Text -> T.Text
cmdA #!>> cmdB = op cmdA ";" cmdB
infixr 0 #!>>
doubleQuote :: T.Text -> T.Text
doubleQuote s = T.concat ["\"", s, "\""]
singleQuote :: T.Text -> T.Text
singleQuote s = T.concat ["'", s, "'"]
skip :: Monad m => m ()
skip = return ()