-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Run
-- Description :  This modules provides several commands to run an external process.
-- Copyright   :  (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Christian Thiemann <mail@christian-thiemann.de>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This modules provides several commands to run an external process.
-- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by
-- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and
-- XMonad.Util.RunInXTerm (by Andrea Rossato).
--
-----------------------------------------------------------------------------

module XMonad.Util.Run (
                          -- * Usage
                          -- $usage
                          runProcessWithInput,
                          runProcessWithInputAndWait,
                          safeSpawn,
                          safeSpawnProg,
                          unsafeSpawn,
                          runInTerm,
                          safeRunInTerm,
                          seconds,
                          spawnPipe,
                          spawnPipeWithLocaleEncoding,
                          spawnPipeWithUtf8Encoding,
                          spawnPipeWithNoEncoding,
                          hPutStr, hPutStrLn  -- re-export for convenience
                         ) where

import Codec.Binary.UTF8.String
import System.Posix.IO
import System.Posix.Process (createSession, executeFile, forkProcess)
import Control.Concurrent (threadDelay)
import System.IO
import System.Process (runInteractiveProcess)
import XMonad
import XMonad.Prelude

-- $usage
-- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh"
--
-- For an example usage of 'runProcessWithInput' see
-- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",
-- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions",
-- "XMonad.Prompt.WorkspaceDir"
--
-- For an example usage of 'runProcessWithInputAndWait' see
-- "XMonad.Util.Dzen"

-- | Returns the output.
runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String
runProcessWithInput :: FilePath -> [FilePath] -> FilePath -> m FilePath
runProcessWithInput FilePath
cmd [FilePath]
args FilePath
input = IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
    (Handle
pin, Handle
pout, Handle
perr, ProcessHandle
_) <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess (FilePath -> FilePath
encodeString FilePath
cmd)
                                            ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
encodeString [FilePath]
args) Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    Handle -> FilePath -> IO ()
hPutStr Handle
pin FilePath
input
    Handle -> IO ()
hClose Handle
pin
    FilePath
output <- Handle -> IO FilePath
hGetContents Handle
pout
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
output FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
output) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Handle -> IO ()
hClose Handle
pout
    Handle -> IO ()
hClose Handle
perr
    -- no need to waitForProcess, we ignore SIGCHLD
    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output

-- | Wait is in &#956; (microseconds)
runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m ()
runProcessWithInputAndWait :: FilePath -> [FilePath] -> FilePath -> Int -> m ()
runProcessWithInputAndWait FilePath
cmd [FilePath]
args FilePath
input Int
timeout = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ProcessID
_ <- IO () -> IO ProcessID
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
        (Handle
pin, Handle
pout, Handle
perr, ProcessHandle
_) <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess (FilePath -> FilePath
encodeString FilePath
cmd)
                                            ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
encodeString [FilePath]
args) Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
        Handle -> FilePath -> IO ()
hPutStr Handle
pin FilePath
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
        -- no need to waitForProcess, we ignore SIGCHLD
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Multiplies by ONE MILLION, for functions that take microseconds.
--
-- Use like:
--
-- > (5.5 `seconds`)
--
-- In GHC 7 and later, you must either enable the PostfixOperators extension
-- (by adding
--
-- > {-# LANGUAGE PostfixOperators #-}
--
-- to the top of your file) or use seconds in prefix form:
--
-- > seconds 5.5
seconds :: Rational -> Int
seconds :: Rational -> Int
seconds = Rational -> Int
forall a. Enum a => a -> Int
fromEnum (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000)

{- | 'safeSpawn' bypasses 'spawn', because spawn passes
strings to \/bin\/sh to be interpreted as shell commands. This is
often what one wants, but in many cases the passed string will contain
shell metacharacters which one does not want interpreted as such (URLs
particularly often have shell metacharacters like \'&\' in them). In
this case, it is more useful to specify a file or program to be run
and a string to give it as an argument so as to bypass the shell and
be certain the program will receive the string as you typed it.

Examples:

> , ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png")
> , ((modm, xK_d    ), safeSpawn "firefox" [])

Note that the unsafeSpawn example must be unsafe and not safe because
it makes use of shell interpretation by relying on @$HOME@ and
interpolation, whereas the safeSpawn example can be safe because
Firefox doesn't need any arguments if it is just being started. -}
safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
safeSpawn :: FilePath -> [FilePath] -> m ()
safeSpawn FilePath
prog [FilePath]
args = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO ProcessID -> IO ()
forall a. IO a -> IO ()
void_ (IO ProcessID -> IO ()) -> IO ProcessID -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
  IO ()
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
  ProcessID
_ <- IO ProcessID
createSession
  FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile (FilePath -> FilePath
encodeString FilePath
prog) Bool
True ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
encodeString [FilePath]
args) Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    where void_ :: IO a -> IO ()
void_ = (IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently

-- | Simplified 'safeSpawn'; only takes a program (and no arguments):
--
-- > , ((modm, xK_d    ), safeSpawnProg "firefox")
safeSpawnProg :: MonadIO m => FilePath -> m ()
safeSpawnProg :: FilePath -> m ()
safeSpawnProg = (FilePath -> [FilePath] -> m ()) -> [FilePath] -> FilePath -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> [FilePath] -> m ()
safeSpawn []

-- | An alias for 'spawn'; the name emphasizes that one is calling out to a
--   Turing-complete interpreter which may do things one dislikes; for details, see 'safeSpawn'.
unsafeSpawn :: MonadIO m => String -> m ()
unsafeSpawn :: FilePath -> m ()
unsafeSpawn = FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
spawn

-- | Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then
-- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn'
unsafeRunInTerm, runInTerm :: String -> String -> X ()
unsafeRunInTerm :: FilePath -> FilePath -> X ()
unsafeRunInTerm FilePath
options FilePath
command = (XConf -> FilePath) -> X FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> FilePath
forall (l :: * -> *). XConfig l -> FilePath
terminal (XConfig Layout -> FilePath)
-> (XConf -> XConfig Layout) -> XConf -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X FilePath -> (FilePath -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
t -> FilePath -> X ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
unsafeSpawn (FilePath -> X ()) -> FilePath -> X ()
forall a b. (a -> b) -> a -> b
$ FilePath
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
options FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" -e " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
command
runInTerm :: FilePath -> FilePath -> X ()
runInTerm = FilePath -> FilePath -> X ()
unsafeRunInTerm

-- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'.
safeRunInTerm :: String -> String -> X ()
safeRunInTerm :: FilePath -> FilePath -> X ()
safeRunInTerm FilePath
options FilePath
command = (XConf -> FilePath) -> X FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> FilePath
forall (l :: * -> *). XConfig l -> FilePath
terminal (XConfig Layout -> FilePath)
-> (XConf -> XConfig Layout) -> XConf -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config) X FilePath -> (FilePath -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FilePath
t -> FilePath -> [FilePath] -> X ()
forall (m :: * -> *). MonadIO m => FilePath -> [FilePath] -> m ()
safeSpawn FilePath
t [FilePath
options, FilePath
" -e " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
command]

-- | Launch an external application through the system shell and
-- return a 'Handle' to its standard input. Note that the 'Handle'
-- is a text 'Handle' using the current locale encoding.
spawnPipe :: MonadIO m => String -> m Handle
spawnPipe :: FilePath -> m Handle
spawnPipe = FilePath -> m Handle
forall (m :: * -> *). MonadIO m => FilePath -> m Handle
spawnPipeWithLocaleEncoding

-- | Same as 'spawnPipe'.
spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle
spawnPipeWithLocaleEncoding :: FilePath -> m Handle
spawnPipeWithLocaleEncoding = TextEncoding -> FilePath -> m Handle
forall (m :: * -> *).
MonadIO m =>
TextEncoding -> FilePath -> m Handle
spawnPipe' TextEncoding
localeEncoding

-- | Same as 'spawnPipe', but forces the UTF-8 encoding regardless of locale.
spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle
spawnPipeWithUtf8Encoding :: FilePath -> m Handle
spawnPipeWithUtf8Encoding = TextEncoding -> FilePath -> m Handle
forall (m :: * -> *).
MonadIO m =>
TextEncoding -> FilePath -> m Handle
spawnPipe' TextEncoding
utf8

-- | Same as 'spawnPipe', but forces the 'char8' encoding, so unicode strings
-- need 'Codec.Binary.UTF8.String.encodeString'. Should never be needed, but
-- some X functions return already encoded Strings, so it may possibly be
-- useful for someone.
spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle
spawnPipeWithNoEncoding :: FilePath -> m Handle
spawnPipeWithNoEncoding = TextEncoding -> FilePath -> m Handle
forall (m :: * -> *).
MonadIO m =>
TextEncoding -> FilePath -> m Handle
spawnPipe' TextEncoding
char8

spawnPipe' :: MonadIO m => TextEncoding -> String -> m Handle
spawnPipe' :: TextEncoding -> FilePath -> m Handle
spawnPipe' TextEncoding
encoding FilePath
x = IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Handle -> m Handle) -> IO Handle -> m Handle
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
_ <- IO () -> IO ProcessID
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
          Fd
_ <- Fd -> Fd -> IO Fd
dupTo Fd
rd Fd
stdInput
          FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
"/bin/sh" Bool
False [FilePath
"-c", FilePath -> FilePath
encodeString FilePath
x] Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    Fd -> IO ()
closeFd Fd
rd
    Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h