{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module XMonad.Util.Run (
runProcessWithInput,
runProcessWithInputAndWait,
safeSpawn,
safeSpawnProg,
unsafeSpawn,
runInTerm,
safeRunInTerm,
seconds,
spawnPipe,
spawnPipeWithLocaleEncoding,
spawnPipeWithUtf8Encoding,
spawnPipeWithNoEncoding,
ProcessConfig (..),
Input,
spawnExternalProcess,
proc,
getInput,
toInput,
inEditor,
inTerm,
termInDir,
inProgram,
(>->),
(>-$),
(>&&>),
(>||>),
inWorkingDir,
eval,
execute,
executeNoQuote,
setXClass,
asString,
EmacsLib (..),
setFrameName,
withEmacsLibs,
inEmacs,
elispFun,
asBatch,
require,
progn,
quote,
findFile,
list,
saveExcursion,
hPutStr,
hPutStrLn,
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.Util.ExtensibleConf as XC
import Codec.Binary.UTF8.String (encodeString)
import Control.Concurrent (threadDelay)
import System.Directory (getDirectoryContents)
import System.IO
import System.Posix.IO
import System.Posix.Process (createSession, executeFile, forkProcess)
import System.Process (runInteractiveProcess)
runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String
runProcessWithInput :: forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
runProcessWithInput String
cmd [String]
args String
input = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
(Handle
pin, Handle
pout, Handle
perr, ProcessHandle
_) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess (Input
encodeString String
cmd)
(forall a b. (a -> b) -> [a] -> [b]
map Input
encodeString [String]
args) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
Handle -> String -> IO ()
hPutStr Handle
pin String
input
Handle -> IO ()
hClose Handle
pin
String
output <- Handle -> IO String
hGetContents Handle
pout
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
output forall a. Eq a => a -> a -> Bool
== String
output) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
Handle -> IO ()
hClose Handle
pout
Handle -> IO ()
hClose Handle
perr
forall (m :: * -> *) a. Monad m => a -> m a
return String
output
runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m ()
runProcessWithInputAndWait :: forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> Int -> m ()
runProcessWithInputAndWait String
cmd [String]
args String
input Int
timeout = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
ProcessID
_ <- forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
(Handle
pin, Handle
pout, Handle
perr, ProcessHandle
_) <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess (Input
encodeString String
cmd)
(forall a b. (a -> b) -> [a] -> [b]
map Input
encodeString [String]
args) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
Handle -> String -> IO ()
hPutStr Handle
pin String
input
Handle -> IO ()
hFlush Handle
pin
Int -> IO ()
threadDelay Int
timeout
Handle -> IO ()
hClose Handle
pin
Handle -> IO ()
hClose Handle
pout
Handle -> IO ()
hClose Handle
perr
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
seconds :: Rational -> Int
seconds :: Rational -> Int
seconds = forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Rational
1000000)
safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
safeSpawn :: forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
prog [String]
args = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall {a}. IO a -> IO ()
void_ forall a b. (a -> b) -> a -> b
$ IO () -> IO ProcessID
forkProcess forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
ProcessID
_ <- IO ProcessID
createSession
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile (Input
encodeString String
prog) Bool
True (forall a b. (a -> b) -> [a] -> [b]
map Input
encodeString [String]
args) forall a. Maybe a
Nothing
where void_ :: IO a -> IO ()
void_ = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())
safeSpawnProg :: MonadIO m => FilePath -> m ()
safeSpawnProg :: forall (m :: * -> *). MonadIO m => String -> m ()
safeSpawnProg = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn []
unsafeSpawn :: MonadIO m => String -> m ()
unsafeSpawn :: forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn = forall (m :: * -> *). MonadIO m => String -> m ()
spawn
unsafeRunInTerm, runInTerm :: String -> String -> X ()
unsafeRunInTerm :: String -> String -> X ()
unsafeRunInTerm String
options String
command = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> String
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
t -> forall (m :: * -> *). MonadIO m => String -> m ()
unsafeSpawn forall a b. (a -> b) -> a -> b
$ String
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
options forall a. [a] -> [a] -> [a]
++ String
" -e " forall a. [a] -> [a] -> [a]
++ String
command
runInTerm :: String -> String -> X ()
runInTerm = String -> String -> X ()
unsafeRunInTerm
safeRunInTerm :: String -> String -> X ()
safeRunInTerm :: String -> String -> X ()
safeRunInTerm String
options String
command = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> String
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
t -> forall (m :: * -> *). MonadIO m => String -> [String] -> m ()
safeSpawn String
t [String
options, String
" -e " forall a. [a] -> [a] -> [a]
++ String
command]
spawnPipe :: MonadIO m => String -> m Handle
spawnPipe :: forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipe = forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipeWithLocaleEncoding
spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle
spawnPipeWithLocaleEncoding :: forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipeWithLocaleEncoding = forall (m :: * -> *).
MonadIO m =>
TextEncoding -> String -> m Handle
spawnPipe' TextEncoding
localeEncoding
spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle
spawnPipeWithUtf8Encoding :: forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipeWithUtf8Encoding = forall (m :: * -> *).
MonadIO m =>
TextEncoding -> String -> m Handle
spawnPipe' TextEncoding
utf8
spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle
spawnPipeWithNoEncoding :: forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipeWithNoEncoding = forall (m :: * -> *).
MonadIO m =>
TextEncoding -> String -> m Handle
spawnPipe' TextEncoding
char8
spawnPipe' :: MonadIO m => TextEncoding -> String -> m Handle
spawnPipe' :: forall (m :: * -> *).
MonadIO m =>
TextEncoding -> String -> m Handle
spawnPipe' TextEncoding
encoding String
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
(Fd
rd, Fd
wr) <- IO (Fd, Fd)
createPipe
Fd -> FdOption -> Bool -> IO ()
setFdOption Fd
wr FdOption
CloseOnExec Bool
True
Handle
h <- Fd -> IO Handle
fdToHandle Fd
wr
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
encoding
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
ProcessID
_ <- forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
Fd
_ <- Fd -> Fd -> IO Fd
dupTo Fd
rd Fd
stdInput
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
"/bin/sh" Bool
False [String
"-c", Input
encodeString String
x] forall a. Maybe a
Nothing
Fd -> IO ()
closeFd Fd
rd
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
data ProcessConfig = ProcessConfig
{ ProcessConfig -> String
editor :: !String
, ProcessConfig -> String
emacsLispDir :: !FilePath
, ProcessConfig -> String
emacsElpaDir :: !FilePath
, ProcessConfig -> String
emacs :: !String
}
spawnExternalProcess :: ProcessConfig -> XConfig l -> XConfig l
spawnExternalProcess :: forall (l :: * -> *). ProcessConfig -> XConfig l -> XConfig l
spawnExternalProcess = forall a (l :: * -> *).
(Default a, Typeable a) =>
(a -> a) -> XConfig l -> XConfig l
XC.modifyDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
instance Default ProcessConfig where
def :: ProcessConfig
def :: ProcessConfig
def = ProcessConfig
{ editor :: String
editor = String
"emacsclient -c -a ''"
, emacsLispDir :: String
emacsLispDir = String
"~/.config/emacs/lisp/"
, emacsElpaDir :: String
emacsElpaDir = String
"~/.config/emacs/elpa/"
, emacs :: String
emacs = String
"emacs"
}
type Input = ShowS
(>->) :: X Input -> X Input -> X Input
>-> :: X Input -> X Input -> X Input
(>->) = forall a. Semigroup a => a -> a -> a
(<>)
infixr 3 >->
(>-$) :: X Input -> X String -> X Input
>-$ :: X Input -> X String -> X Input
(>-$) X Input
xi X String
xs = X Input
xi X Input -> X Input -> X Input
>-> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Input
mkDList X String
xs
infixr 3 >-$
(>&&>) :: X Input -> X Input -> X Input
X Input
a >&&> :: X Input -> X Input -> X Input
>&&> X Input
b = X Input
a forall a. Semigroup a => a -> a -> a
<> String -> X Input
toInput String
" && " forall a. Semigroup a => a -> a -> a
<> X Input
b
infixr 2 >&&>
(>||>) :: X Input -> X Input -> X Input
X Input
a >||> :: X Input -> X Input -> X Input
>||> X Input
b = X Input
a forall a. Semigroup a => a -> a -> a
<> String -> X Input
toInput String
" || " forall a. Semigroup a => a -> a -> a
<> X Input
b
infixr 2 >||>
proc :: X Input -> X ()
proc :: X Input -> X ()
proc X Input
xi = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X Input -> X String
getInput X Input
xi
toInput :: String -> X Input
toInput :: String -> X Input
toInput = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input
mkDList
getInput :: X Input -> X String
getInput :: X Input -> X String
getInput X Input
xi = X Input
xi forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall a b. (a -> b) -> a -> b
$ String
"")
inEditor :: X Input
inEditor :: X Input
inEditor = forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef forall a b. (a -> b) -> a -> b
$ \ProcessConfig{String
editor :: String
editor :: ProcessConfig -> String
editor} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Input
mkDList String
editor
inTerm :: X Input
inTerm :: X Input
inTerm = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ String -> Input
mkDList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> String
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
execute :: String -> X Input
execute :: String -> X Input
execute String
this = forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
" -e " forall a. Semigroup a => a -> a -> a
<> Input
tryQuote String
this) forall a. Semigroup a => a -> a -> a
<>)
executeNoQuote :: String -> X Input
executeNoQuote :: String -> X Input
executeNoQuote String
this = forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
" -e " forall a. Semigroup a => a -> a -> a
<> String
this) forall a. Semigroup a => a -> a -> a
<>)
eval :: String -> X Input
eval :: String -> X Input
eval String
this = forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
" --eval " forall a. Semigroup a => a -> a -> a
<> Input
tryQuote String
this) forall a. Semigroup a => a -> a -> a
<>)
inEmacs :: X Input
inEmacs :: X Input
inEmacs = forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef forall a b. (a -> b) -> a -> b
$ \ProcessConfig{String
emacs :: String
emacs :: ProcessConfig -> String
emacs} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Input
mkDList String
emacs
inProgram :: String -> X Input
inProgram :: String -> X Input
inProgram = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input
mkDList
inWorkingDir :: X Input
inWorkingDir :: X Input
inWorkingDir = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
" --working-directory " forall a. Semigroup a => a -> a -> a
<>)
setFrameName :: String -> X Input
setFrameName :: String -> X Input
setFrameName String
n = forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String
" -F '(quote (name . \"" forall a. Semigroup a => a -> a -> a
<> String
n forall a. Semigroup a => a -> a -> a
<> String
"\"))' ") forall a. Semigroup a => a -> a -> a
<>)
setXClass :: String -> X Input
setXClass :: String -> X Input
setXClass = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input
mkDList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" --class " forall a. Semigroup a => a -> a -> a
<>)
termInDir :: X Input
termInDir :: X Input
termInDir = X Input
inTerm X Input -> X Input -> X Input
>-> X Input
inWorkingDir
elispFun :: String -> String
elispFun :: Input
elispFun String
f = String
" '( " forall a. Semigroup a => a -> a -> a
<> String
f forall a. Semigroup a => a -> a -> a
<> String
" )' "
asString :: String -> String
asString :: Input
asString String
s = String
" \"" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"\" "
progn :: [String] -> String
progn :: [String] -> String
progn = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"progn " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Input
inParens
require :: String -> String
require :: Input
require = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"require " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input
quote
quote :: String -> String
quote :: Input
quote = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"quote " forall a. Semigroup a => a -> a -> a
<>)
findFile :: String -> String
findFile :: Input
findFile = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"find-file" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input
asString
list :: [String] -> String
list :: [String] -> String
list = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"list " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords
saveExcursion :: [String] -> String
saveExcursion :: [String] -> String
saveExcursion = Input
inParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"save-excursion " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Input
inParens
asBatch :: X Input
asBatch :: X Input
asBatch = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
" --batch " forall a. Semigroup a => a -> a -> a
<>)
data EmacsLib
= OwnFile !String
| ElpaLib !String
| Special !String
withEmacsLibs :: [EmacsLib] -> X Input
withEmacsLibs :: [EmacsLib] -> X Input
withEmacsLibs [EmacsLib]
libs = forall (m :: * -> *) a b.
(MonadReader XConf m, Typeable a, Default a) =>
(a -> m b) -> m b
XC.withDef forall a b. (a -> b) -> a -> b
$ \ProcessConfig{String
emacsLispDir :: String
emacsLispDir :: ProcessConfig -> String
emacsLispDir, String
emacsElpaDir :: String
emacsElpaDir :: ProcessConfig -> String
emacsElpaDir} -> do
String
lispDir <- forall (m :: * -> *). MonadIO m => String -> m String
mkAbsolutePath String
emacsLispDir
String
elpaDir <- forall (m :: * -> *). MonadIO m => String -> m String
mkAbsolutePath String
emacsElpaDir
[String]
lisp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
lispDir
[String]
elpa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
elpaDir
let EmacsLib -> Maybe String
getLib :: EmacsLib -> Maybe String = \case
OwnFile String
f -> ((String
"-l " forall a. Semigroup a => a -> a -> a
<> String
lispDir) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String
f forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
lisp
ElpaLib String
d -> ((String
"-L " forall a. Semigroup a => a -> a -> a
<> String
elpaDir) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
d forall a. Semigroup a => a -> a -> a
<> String
"-") forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
elpa
Special String
f -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
" -l " forall a. Semigroup a => a -> a -> a
<> String
f
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Input
mkDList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe EmacsLib -> Maybe String
getLib forall a b. (a -> b) -> a -> b
$ [EmacsLib]
libs
mkDList :: String -> ShowS
mkDList :: String -> Input
mkDList = forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> String
" ")
inParens :: String -> String
inParens :: Input
inParens String
s = case String
s of
Char
'(' : String
_ -> String
s
String
_ -> String
"(" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
")"
tryQuote :: String -> String
tryQuote :: Input
tryQuote String
s = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') String
s of
Char
'\'' : String
_ -> String
s
String
_ -> String
"'" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"'"