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

{-# 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

-- readProcess :: P.ProcessConfig a b c -> IO (ExitCode, B.ByteString, B.ByteString)
-- readProcess = withDefaultSignalHandlers . P.readProcess

runProcess :: P.ProcessConfig a b c -> IO ExitCode
runProcess = withDefaultSignalHandlers . P.runProcess

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 . P.startProcess . shell

spawnAt :: MonadIO m => FilePath -> T.Text -> m ()
spawnAt fp = liftIO . void . P.startProcess . P.setWorkingDir fp . shell

spawnStdin :: MonadIO m => B.ByteString -> T.Text -> m ()
spawnStdin i =
  liftIO . void . P.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 ()