{-|
Some simple String wrappers of `readProcess`, `readProcessWithExitCode`,
`rawSystem` from the Haskell <https://hackage.haskell.org/package/process process> library.

Simplest is

@cmd_ :: String -> [String] -> IO ()@

which outputs to stdout. For example:

@cmd_ "git" ["clone", url]@

Then

@cmd :: String -> [String] -> IO String@

returns stdout as a @String@.

There are also @cmdBool@, @cmdMaybe@, @cmdLines@, @shell@, and others.

Other examples:

@grep_ pat file :: IO Bool@

@sudo c args :: IO ()@

-}

module SimpleCmd (
  cmd, cmd_,
  cmdBool,
  cmdIgnoreErr, {- badly named -}
  cmdLines,
  cmdMaybe,
  cmdFull,
  cmdLog, cmdlog {-TODO: remove for 0.3 -},
  cmdN,
  cmdQuiet,
  cmdSilent,
  cmdStdIn,
  cmdStdErr,
  cmdTry_,
  cmdStderrToStdout,
  cmdStderrToStdoutIn,
  error',
  egrep_, grep, grep_,
  ifM,
  logMsg,
  needProgram,
  removePrefix, removeStrictPrefix, removeSuffix,
  shell, shell_,
  shellBool,
  sudo, sudo_,
  warning,
  PipeCommand,
  pipe, pipe_, pipeBool,
  pipe3, pipe3_, pipeFile_,
  whenM,
  (+-+)) where

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad.Extra

import Data.List (stripPrefix)
import Data.Maybe (isJust, isNothing, fromMaybe)

import System.Directory (findExecutable)
import System.Exit (ExitCode (..))
import System.IO (hGetContents, hPutStr, hPutStrLn, IOMode(ReadMode),
                  stderr, stdout, withFile)
import System.Posix.User (getEffectiveUserID)
import System.Process (createProcess, proc, ProcessHandle, rawSystem, readProcess,
                       readProcessWithExitCode, runProcess, showCommandForUser,
                       std_err, std_in, std_out, StdStream(CreatePipe, UseHandle),
                       waitForProcess, withCreateProcess)

removeTrailingNewline :: String -> String
removeTrailingNewline :: String -> String
removeTrailingNewline "" = ""
removeTrailingNewline str :: String
str =
  if String -> Char
forall a. [a] -> a
last String
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n'
  then String -> String
forall a. [a] -> [a]
init String
str
  else String
str

quoteCmd :: String -> [String] -> String
quoteCmd :: String -> [String] -> String
quoteCmd = String -> [String] -> String
showCommandForUser

-- | Alias for errorWithoutStackTrace (for base >= 4.9)
--
-- @since 0.1.4
error' :: String -> a
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0))
error' :: String -> a
error' = String -> a
forall a. String -> a
errorWithoutStackTrace
#else
error' = error
#endif

-- | @cmd c args@ runs a command in a process and returns stdout
cmd :: String -- ^ command to run
    -> [String] -- ^ list of arguments
    -> IO String -- ^ stdout
cmd :: String -> [String] -> IO String
cmd c :: String
c args :: [String]
args = String -> [String] -> String -> IO String
cmdStdIn String
c [String]
args ""

-- | @cmd_ c args@ runs command in a process, output goes to stdout and stderr
cmd_ :: String -> [String] -> IO ()
cmd_ :: String -> [String] -> IO ()
cmd_ c :: String
c args :: [String]
args = do
  ExitCode
ret <- String -> [String] -> IO ExitCode
rawSystem String
c [String]
args
  case ExitCode
ret of
    ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExitFailure n :: Int
n -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
quoteCmd String
c [String]
args String -> String -> String
+-+ "failed with exit code" String -> String -> String
+-+ Int -> String
forall a. Show a => a -> String
show Int
n

boolWrapper :: IO ExitCode -> IO Bool
boolWrapper :: IO ExitCode -> IO Bool
boolWrapper pr :: IO ExitCode
pr = do
  ExitCode
ret <- IO ExitCode
pr
  case ExitCode
ret of
    ExitSuccess -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    ExitFailure _ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | @cmdBool c args@ runs a command, and return Boolean status
cmdBool :: String -> [String] -> IO Bool
cmdBool :: String -> [String] -> IO Bool
cmdBool c :: String
c args :: [String]
args =
  IO ExitCode -> IO Bool
boolWrapper (String -> [String] -> IO ExitCode
rawSystem String
c [String]
args)

-- | @cmdMaybe c args@ runs a command, maybe returning output if it succeeds
cmdMaybe :: String -> [String] -> IO (Maybe String)
cmdMaybe :: String -> [String] -> IO (Maybe String)
cmdMaybe c :: String
c args :: [String]
args = do
  (ok :: Bool
ok, out :: String
out, _err :: String
_err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args ""
  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
ok then String -> Maybe String
forall a. a -> Maybe a
Just String
out else Maybe String
forall a. Maybe a
Nothing

-- | @cmdLines c args@ runs a command, and returns list of stdout lines
--
-- @since 0.1.1
cmdLines :: String -> [String] -> IO [String]
cmdLines :: String -> [String] -> IO [String]
cmdLines c :: String
c args :: [String]
args = String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
cmd String
c [String]
args

-- | @cmdStdIn c args inp@ runs a command, passing input string as stdin, and returns stdout
cmdStdIn :: String -> [String] -> String -> IO String
cmdStdIn :: String -> [String] -> String -> IO String
cmdStdIn c :: String
c args :: [String]
args inp :: String
inp = String -> String
removeTrailingNewline (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
c [String]
args String
inp

-- | @shell cs@ runs a command string in a shell, and returns stdout
shell :: String -> IO String
shell :: String -> IO String
shell cs :: String
cs = String -> [String] -> IO String
cmd "sh" ["-c", String
cs]

-- | @shell_ cs@ runs a command string in a shell, output goes to stdout
shell_ :: String -> IO ()
shell_ :: String -> IO ()
shell_ cs :: String
cs = String -> [String] -> IO ()
cmd_ "sh" ["-c", String
cs]

-- | @shellBool cs@ runs a command string in a shell, output goes to stdout
--
-- @since 0.2.0
shellBool :: String -> IO Bool
shellBool :: String -> IO Bool
shellBool cs :: String
cs =
  IO ExitCode -> IO Bool
boolWrapper (String -> [String] -> IO ExitCode
rawSystem "sh" ["-c", String
cs])

-- FIXME cmdLog_
-- | @cmdLog c args@ logs a command with a datestamp
--
-- @since 0.1.4
cmdLog :: String -> [String] -> IO ()
cmdLog :: String -> [String] -> IO ()
cmdLog c :: String
c args :: [String]
args = do
  String -> IO ()
logMsg (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args
  String -> [String] -> IO ()
cmd_ String
c [String]
args

-- | @cmdlog@ deprecated alias for 'cmdLog' (will be removed in 0.3)
cmdlog :: String -> [String] -> IO ()
cmdlog :: String -> [String] -> IO ()
cmdlog = String -> [String] -> IO ()
cmdLog

-- | @logMsg msg@ outputs message with a timestamp
logMsg :: String -> IO ()
logMsg :: String -> IO ()
logMsg msg :: String
msg = do
  String
date <- String -> [String] -> IO String
cmd "date" ["+%T"]
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
date String -> String -> String
+-+ String
msg

-- | @cmdN c args@ dry-runs a command: prints command to stdout - more used for debugging
cmdN :: String -> [String] -> IO ()
cmdN :: String -> [String] -> IO ()
cmdN c :: String
c args :: [String]
args = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args

-- | @cmdStdErr c args@ runs command in a process, returning stdout and stderr
cmdStdErr :: String -> [String] -> IO (String, String)
cmdStdErr :: String -> [String] -> IO (String, String)
cmdStdErr c :: String
c args :: [String]
args = do
  (_ok :: Bool
_ok, out :: String
out, err :: String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args ""
  (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
out, String
err)

-- -- | @cmdAssert msg c args@ runs command, if it fails output msg as error'.
-- cmdAssert :: String -> String -> [String] -> IO ()
-- cmdAssert msg c args = do
--   ret <- rawSystem c args
--   case ret of
--     ExitSuccess -> return ()
--     ExitFailure _ -> error' msg

-- | @cmdQuiet c args@ runs a command hiding stderr, if it succeeds returns stdout
cmdQuiet :: String -> [String] -> IO String
cmdQuiet :: String -> [String] -> IO String
cmdQuiet c :: String
c args :: [String]
args = do
  (ok :: Bool
ok, out :: String
out, err :: String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args ""
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ if Bool
ok
    then String
out
    else String -> String
forall a. String -> a
error' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
quoteCmd String
c [String]
args String -> String -> String
+-+ "failed with\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

-- | @cmdSilent c args@ runs a command hiding stdout: stderr is only output if it fails.
cmdSilent :: String -> [String] -> IO ()
cmdSilent :: String -> [String] -> IO ()
cmdSilent c :: String
c args :: [String]
args = do
  (ret :: Bool
ret, _, err :: String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args ""
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ret (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
quoteCmd String
c [String]
args String -> String -> String
+-+ "failed with\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

-- -- | @cmdSilentIn c args inp@ is like @cmdSilent@ but additionally takes some stdin
-- cmdSilentIn :: String -> [String] -> String -> IO ()
-- cmdSilentIn c args inp = do
--   (ret, _, err) <- cmdFull c args inp
--   unless ret $
--     error' $ quoteCmd c args +-+ "failed with:\n" ++ err

-- | @cmdIgnoreErr c args inp@ runs a command with input, drops stderr, and return stdout
cmdIgnoreErr :: String -> [String] -> String -> IO String
cmdIgnoreErr :: String -> [String] -> String -> IO String
cmdIgnoreErr c :: String
c args :: [String]
args input :: String
input = do
  (_ret :: Bool
_ret, out :: String
out, _err :: String
_err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args String
input
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
out

-- | @cmdFull c args inp@ runs readProcessWithExitCode and converts the ExitCode to Bool
-- Removes the last newline from stdout and stderr (like the other functions)
cmdFull :: String -> [String] -> String -> IO (Bool, String, String)
cmdFull :: String -> [String] -> String -> IO (Bool, String, String)
cmdFull c :: String
c args :: [String]
args input :: String
input = do
  (ret :: ExitCode
ret, out :: String
out, err :: String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
c [String]
args String
input
  (Bool, String, String) -> IO (Bool, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ret ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess, String -> String
removeTrailingNewline String
out, String -> String
removeTrailingNewline String
err)

-- | @cmdTry_ c args@ runs the command if available
--
-- @since 0.2.1
cmdTry_ :: String -> [String] -> IO ()
cmdTry_ :: String -> [String] -> IO ()
cmdTry_ c :: String
c args :: [String]
args = do
  Maybe String
have <- String -> IO (Maybe String)
findExecutable String
c
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
have) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> IO ()
cmd_ String
c [String]
args

-- | Redirect stderr to stdout, ie with interleaved output
--
-- @since 0.2.2
cmdStderrToStdout :: String -> [String] -> IO (ExitCode, String)
cmdStderrToStdout :: String -> [String] -> IO (ExitCode, String)
cmdStderrToStdout c :: String
c args :: [String]
args = do
  (_ , Just hout :: Handle
hout, _, p :: ProcessHandle
p) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ((String -> [String] -> CreateProcess
proc String
c [String]
args)
                                          {std_out :: StdStream
std_out = StdStream
CreatePipe,
                                           std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
stdout})
  ExitCode
ret <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
  String
out <- Handle -> IO String
hGetContents Handle
hout
  (ExitCode, String) -> IO (ExitCode, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ret, String -> String
removeTrailingNewline String
out)

-- | Redirect stderr to stdout, ie with interleaved output
--
-- @since 0.2.3
cmdStderrToStdoutIn :: String -> [String] -> String -> IO (Bool, String)
cmdStderrToStdoutIn :: String -> [String] -> String -> IO (Bool, String)
cmdStderrToStdoutIn c :: String
c args :: [String]
args inp :: String
inp = do
  (Just hin :: Handle
hin, Just hout :: Handle
hout, _, p :: ProcessHandle
p) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ((String -> [String] -> CreateProcess
proc String
c [String]
args)
                                          {std_in :: StdStream
std_in  = StdStream
CreatePipe,
                                           std_out :: StdStream
std_out = StdStream
CreatePipe,
                                           std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
stdout})
  Handle -> String -> IO ()
hPutStr Handle
hin String
inp
  ExitCode
ret <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
  String
out <- Handle -> IO String
hGetContents Handle
hout
  (Bool, String) -> IO (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ret ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess, String -> String
removeTrailingNewline String
out)

-- | @grep pat file@ greps pattern in file, and returns list of matches
--
-- @since 0.1.2 (fixed not to error in 0.2.2)
grep :: String -> FilePath -> IO [String]
grep :: String -> String -> IO [String]
grep pat :: String
pat file :: String
file = do
  Maybe String
mres <- String -> [String] -> IO (Maybe String)
cmdMaybe "grep" [String
pat, String
file]
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
lines Maybe String
mres

-- | @grep_ pat file@ greps pattern in file and returns Boolean status
grep_ :: String -- ^ pattern
      -> FilePath -- ^ file
      -> IO Bool -- ^ result
grep_ :: String -> String -> IO Bool
grep_ pat :: String
pat file :: String
file =
  String -> [String] -> IO Bool
cmdBool "grep" ["-q", String
pat, String
file]

-- | @egrep_ pat file@ greps extended regexp in file, and returns Boolean status
egrep_ :: String -> FilePath -> IO Bool
egrep_ :: String -> String -> IO Bool
egrep_ pat :: String
pat file :: String
file =
  String -> [String] -> IO Bool
cmdBool "grep" ["-q", "-e", String
pat, String
file]

-- | @sudo c args@ runs a command as sudo returning stdout
--
-- Result type changed from IO () to IO String in 0.2.0
sudo :: String -- ^ command
     -> [String] -- ^ arguments
     -> IO String
sudo :: String -> [String] -> IO String
sudo = (String -> [String] -> IO String)
-> String -> [String] -> IO String
forall a.
(String -> [String] -> IO a) -> String -> [String] -> IO a
sudoInternal String -> [String] -> IO String
cmd

-- | @sudo_ c args@ runs a command as sudo
--
-- @since 0.2.0
sudo_ :: String -- ^ command
     -> [String] -- ^ arguments
     -> IO ()
sudo_ :: String -> [String] -> IO ()
sudo_ = (String -> [String] -> IO ()) -> String -> [String] -> IO ()
forall a.
(String -> [String] -> IO a) -> String -> [String] -> IO a
sudoInternal String -> [String] -> IO ()
cmdLog

sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a
sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a
sudoInternal exc :: String -> [String] -> IO a
exc c :: String
c args :: [String]
args = do
  UserID
uid <- IO UserID
getEffectiveUserID
  Maybe String
sd <- if UserID
uid UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== 0
    then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    else String -> IO (Maybe String)
findExecutable "sudo"
  let noSudo :: Bool
noSudo = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
sd
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserID
uid UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& Bool
noSudo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
warning "'sudo' not found"
  String -> [String] -> IO a
exc (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
c Maybe String
sd) (if Bool
noSudo then [String]
args else String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args)

-- | Combine two strings with a single space
infixr 4 +-+
(+-+) :: String -> String -> String
"" +-+ :: String -> String -> String
+-+ s :: String
s = String
s
s :: String
s +-+ "" = String
s
s :: String
s +-+ t :: String
t | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
        | String -> Char
forall a. [a] -> a
head String
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
s :: String
s +-+ t :: String
t = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t

-- singleLine :: String -> String
-- singleLine "" = ""
-- singleLine s = (head . lines) s

-- | @removePrefix prefix original@ removes prefix from string if present
removePrefix :: String -> String-> String
removePrefix :: String -> String -> String
removePrefix prefix :: String
prefix orig :: String
orig =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
orig (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
orig

-- | @removeStrictPrefix prefix original@ removes prefix, or fails with error'
removeStrictPrefix :: String -> String -> String
removeStrictPrefix :: String -> String -> String
removeStrictPrefix prefix :: String
prefix orig :: String
orig =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> String
forall a. String -> a
error' String
prefix String -> String -> String
+-+ "is not prefix of" String -> String -> String
+-+ String
orig) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
orig

-- | @removeSuffix suffix original@ removes suffix from string if present
removeSuffix :: String -> String -> String
removeSuffix :: String -> String -> String
removeSuffix suffix :: String
suffix orig :: String
orig =
  String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
orig (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix String
suffix String
orig
  where
    stripSuffix :: [a] -> [a] -> Maybe [a]
stripSuffix sf :: [a]
sf str :: [a]
str = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
sf) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
str)

-- | @warning@ outputs to stderr
--
-- @since 0.2.0
warning :: String -> IO ()
warning :: String -> IO ()
warning = Handle -> String -> IO ()
hPutStrLn Handle
stderr


-- | Type alias for a command in a pipe
--
-- @since 0.2.0
type PipeCommand = (String,[String])

-- | Return stdout from piping the output of one process to another
--
-- @since 0.2.0
pipe :: PipeCommand -> PipeCommand -> IO String
pipe :: PipeCommand -> PipeCommand -> IO String
pipe (c1 :: String
c1,args1 :: [String]
args1) (c2 :: String
c2,args2 :: [String]
args2) =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c1 [String]
args1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
 -> IO String)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a b. (a -> b) -> a -> b
$
    \ _si :: Maybe Handle
_si (Just ho1 :: Handle
ho1) _se :: Maybe Handle
_se p1 :: ProcessHandle
p1 -> do
      (_, Just ho2 :: Handle
ho2, _, p2 :: ProcessHandle
p2) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ((String -> [String] -> CreateProcess
proc String
c2 [String]
args2) {std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
ho1, std_out :: StdStream
std_out = StdStream
CreatePipe})
      String
out <- Handle -> IO String
hGetContents Handle
ho2
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p1
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p2
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
removeTrailingNewline String
out

-- | Pipe two commands without returning anything
--
-- @since 0.2.0
pipe_ :: PipeCommand -> PipeCommand -> IO ()
pipe_ :: PipeCommand -> PipeCommand -> IO ()
pipe_ (c1 :: String
c1,args1 :: [String]
args1) (c2 :: String
c2,args2 :: [String]
args2) =
  IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ PipeCommand -> PipeCommand -> IO ProcessHandle
pipeInternal (String
c1,[String]
args1) (String
c2,[String]
args2) IO ProcessHandle -> (ProcessHandle -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> IO ExitCode
waitForProcess

-- | Bool result of piping of commands
--
-- @since 0.2.0
pipeBool :: PipeCommand -> PipeCommand -> IO Bool
pipeBool :: PipeCommand -> PipeCommand -> IO Bool
pipeBool (c1 :: String
c1,args1 :: [String]
args1) (c2 :: String
c2,args2 :: [String]
args2) =
  IO ExitCode -> IO Bool
boolWrapper (IO ExitCode -> IO Bool) -> IO ExitCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ PipeCommand -> PipeCommand -> IO ProcessHandle
pipeInternal (String
c1,[String]
args1) (String
c2,[String]
args2) IO ProcessHandle -> (ProcessHandle -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> IO ExitCode
waitForProcess

pipeInternal :: PipeCommand -> PipeCommand -> IO ProcessHandle
pipeInternal :: PipeCommand -> PipeCommand -> IO ProcessHandle
pipeInternal (c1 :: String
c1,args1 :: [String]
args1) (c2 :: String
c2,args2 :: [String]
args2) =
  -- nicer with process-typed:
  -- withProcess_ (setStdout createPipe proc1) $ \ p -> runProcess (setStdin (useHandleClose (getStdout p)) proc2)
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> ProcessHandle
    -> IO ProcessHandle)
-> IO ProcessHandle
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c1 [String]
args1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Maybe Handle
  -> Maybe Handle
  -> Maybe Handle
  -> ProcessHandle
  -> IO ProcessHandle)
 -> IO ProcessHandle)
-> (Maybe Handle
    -> Maybe Handle
    -> Maybe Handle
    -> ProcessHandle
    -> IO ProcessHandle)
-> IO ProcessHandle
forall a b. (a -> b) -> a -> b
$
    \ _si :: Maybe Handle
_si so :: Maybe Handle
so _se :: Maybe Handle
_se p1 :: ProcessHandle
p1 -> do
      ProcessHandle
p2 <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
c2 [String]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
so Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p1
      ProcessHandle -> IO ProcessHandle
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
p2

-- | Pipe 3 commands, returning stdout
--
-- @since 0.2.3
pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String
pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String
pipe3 (c1 :: String
c1,a1 :: [String]
a1) (c2 :: String
c2,a2 :: [String]
a2) (c3 :: String
c3,a3 :: [String]
a3) =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c1 [String]
a1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
 -> IO String)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a b. (a -> b) -> a -> b
$
  \ _hi1 :: Maybe Handle
_hi1 (Just ho1 :: Handle
ho1) _he1 :: Maybe Handle
_he1 p1 :: ProcessHandle
p1 ->
    CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c2 [String]
a2) {std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
ho1, std_out :: StdStream
std_out = StdStream
CreatePipe}) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
 -> IO String)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO String)
-> IO String
forall a b. (a -> b) -> a -> b
$
    \ _hi2 :: Maybe Handle
_hi2 (Just ho2 :: Handle
ho2) _he2 :: Maybe Handle
_he2 p2 :: ProcessHandle
p2 -> do
      (_, Just ho3 :: Handle
ho3, _, p3 :: ProcessHandle
p3) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess ((String -> [String] -> CreateProcess
proc String
c3 [String]
a3) {std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
ho2, std_out :: StdStream
std_out = StdStream
CreatePipe})
      String
out <- Handle -> IO String
hGetContents Handle
ho3
      [ProcessHandle] -> (ProcessHandle -> IO ExitCode) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProcessHandle
p1,ProcessHandle
p2,ProcessHandle
p3] ProcessHandle -> IO ExitCode
waitForProcess
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
removeTrailingNewline String
out

-- | Pipe 3 commands, not returning anything
--
-- @since 0.2.0
pipe3_ :: PipeCommand -> PipeCommand -> PipeCommand -> IO ()
pipe3_ :: PipeCommand -> PipeCommand -> PipeCommand -> IO ()
pipe3_ (c1 :: String
c1,a1 :: [String]
a1) (c2 :: String
c2,a2 :: [String]
a2) (c3 :: String
c3,a3 :: [String]
a3) =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c1 [String]
a1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
 -> IO ())
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$
  \ _hi1 :: Maybe Handle
_hi1 (Just ho1 :: Handle
ho1) _he1 :: Maybe Handle
_he1 p1 :: ProcessHandle
p1 ->
    CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c2 [String]
a2) {std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
ho1, std_out :: StdStream
std_out = StdStream
CreatePipe}) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
 -> IO ())
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$
    \ _hi2 :: Maybe Handle
_hi2 ho2 :: Maybe Handle
ho2 _he2 :: Maybe Handle
_he2 p2 :: ProcessHandle
p2 -> do
      ProcessHandle
p3 <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
c3 [String]
a3 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
ho2 Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing
      [ProcessHandle] -> (ProcessHandle -> IO ExitCode) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProcessHandle
p1,ProcessHandle
p2,ProcessHandle
p3] ProcessHandle -> IO ExitCode
waitForProcess

-- | Pipe a file to the first of a pipe of commands
--
-- @since 0.2.0
pipeFile_ :: FilePath -> PipeCommand -> PipeCommand -> IO ()
pipeFile_ :: String -> PipeCommand -> PipeCommand -> IO ()
pipeFile_ infile :: String
infile (c1 :: String
c1,a1 :: [String]
a1) (c2 :: String
c2,a2 :: [String]
a2) =
  String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
infile IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \ hin :: Handle
hin ->
    CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess ((String -> [String] -> CreateProcess
proc String
c1 [String]
a1) { std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
hin, std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
 -> IO ())
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$
    \ _si :: Maybe Handle
_si so :: Maybe Handle
so _se :: Maybe Handle
_se p1 :: ProcessHandle
p1 -> do
      ProcessHandle
p2 <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
c2 [String]
a2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
so Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p1
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p2

-- | Assert program in PATH
--
-- @needProgram progname@
--
-- @since 0.2.1
needProgram :: String -> IO ()
needProgram :: String -> IO ()
needProgram prog :: String
prog = do
  Maybe String
mx <- String -> IO (Maybe String)
findExecutable String
prog
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "missing program: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog