{-# LANGUAGE CPP #-}

{-|
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,
  needProgram,
  error',
  warning,
  logMsg,
  (+-+),
  removePrefix, removeStrictPrefix, removeSuffix,
  egrep_, grep, grep_,
  shell, shell_,
  shellBool,
  sudo, sudo_,
  PipeCommand,
  pipe, pipe_, pipeBool,
  pipe3, pipe3_, pipeFile_,
  ifM,
  whenM,
  filesWithExtension,
  fileWithExtension,
  timeIO
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Exception
import Control.Monad.Extra

import Data.List (
#if !MIN_VERSION_filepath(1,4,2)
  isSuffixOf,
#endif
  stripPrefix)
import Data.Maybe (isJust, isNothing, fromMaybe)
import Data.Time.Clock
#if MIN_VERSION_time(1,9,0)
import Data.Time.Format (formatTime, defaultTimeLocale)
#endif
import System.Directory (findExecutable, listDirectory)
import System.Exit (ExitCode (..))
import System.FilePath
import System.IO (hGetContents, hPutStr, hPutStrLn, IOMode(ReadMode),
                  stderr, stdout, withFile, Handle)
import System.Posix.User (getEffectiveUserID)
import System.Process (createProcess, CreateProcess (cmdspec), 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 String
"" = String
""
removeTrailingNewline String
str =
  if String -> Char
forall a. [a] -> a
last String
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\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
s = String -> a
forall a. String -> a
errorWithoutStackTrace (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$! String
s
#else
error' s = error $! s
#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 String
c [String]
args = String -> [String] -> String -> IO String
cmdStdIn String
c [String]
args String
""

-- | @cmd_ c args@ runs command in a process, output goes to stdout and stderr
cmd_ :: String -> [String] -> IO ()
cmd_ :: String -> [String] -> IO ()
cmd_ String
c [String]
args = do
  ExitCode
ret <- String -> [String] -> IO ExitCode
rawSystem String
c [String]
args
  case ExitCode
ret of
    ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExitFailure 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
+-+ 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 IO ExitCode
pr = do
  ExitCode
ret <- IO ExitCode
pr
  case ExitCode
ret of
    ExitCode
ExitSuccess -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    ExitFailure Int
_ -> 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 String
c [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 String
c [String]
args = do
  (Bool
ok, String
out, String
_err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args String
""
  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 String
c [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 String
c [String]
args 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 String
cs = String -> [String] -> IO String
cmd String
"sh" [String
"-c", String
cs]

-- | @shell_ cs@ runs a command string in a shell, output goes to stdout
shell_ :: String -> IO ()
shell_ :: String -> IO ()
shell_ String
cs = String -> [String] -> IO ()
cmd_ String
"sh" [String
"-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 String
cs =
  IO ExitCode -> IO Bool
boolWrapper (String -> [String] -> IO ExitCode
rawSystem String
"sh" [String
"-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 String
c [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 String
msg = do
  String
date <- String -> [String] -> IO String
cmd String
"date" [String
"+%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 String
c [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
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. Show a => a -> String
show [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 String
c [String]
args = do
  (Bool
_ok, String
out, String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args String
""
  (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 String
c [String]
args = do
  (Bool
ok, String
out, String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args String
""
  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
+-+ 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 String
c [String]
args = do
  (Bool
ret, String
_, String
err) <- String -> [String] -> String -> IO (Bool, String, String)
cmdFull String
c [String]
args String
""
  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
+-+ 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 String
c [String]
args String
input = do
  (Bool
_ret, String
out, 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 String
c [String]
args String
input = do
  (ExitCode
ret, String
out, 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_ String
c [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 String
c [String]
args = do
  (Maybe Handle
_ , Just Handle
hout, Maybe Handle
_, 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 String
c [String]
args String
inp = do
  (Just Handle
hin, Just Handle
hout, Maybe Handle
_, 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 String
pat String
file = do
  Maybe String
mres <- String -> [String] -> IO (Maybe String)
cmdMaybe String
"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_ String
pat String
file =
  String -> [String] -> IO Bool
cmdBool String
"grep" [String
"-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_ String
pat String
file =
  String -> [String] -> IO Bool
cmdBool String
"grep" [String
"-q", String
"-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 String -> [String] -> IO a
exc String
c [String]
args = do
  UserID
uid <- IO UserID
getEffectiveUserID
  Maybe String
sd <- if UserID
uid UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
== UserID
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 String
"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
/= UserID
0 Bool -> Bool -> Bool
&& Bool
noSudo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
warning String
"'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 -> String
+-+ String
s = String
s
String
s +-+ String
"" = String
s
String
s +-+ String
t | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = 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
== Char
' ' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
String
s +-+ String
t = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " 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 String
prefix 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 String
prefix 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
+-+ 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 String
suffix 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 [a]
sf [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 String
s = Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$! String
s


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

withCreateProcessOutput :: CreateProcess -> (Handle  -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput :: CreateProcess -> (Handle -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput CreateProcess
p Handle -> ProcessHandle -> IO a
act =
  CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
p ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
 -> IO a)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$
    \ Maybe Handle
_si Maybe Handle
mso Maybe Handle
_se ProcessHandle
p' ->
      case Maybe Handle
mso of
        Maybe Handle
Nothing -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"no stdout handle for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CmdSpec -> String
forall a. Show a => a -> String
show (CreateProcess -> CmdSpec
cmdspec CreateProcess
p)
        Just Handle
so -> Handle -> ProcessHandle -> IO a
act Handle
so ProcessHandle
p'

-- | 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 (String
c1,[String]
args1) (String
c2,[String]
args2) =
  CreateProcess
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a.
CreateProcess -> (Handle -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput ((String -> [String] -> CreateProcess
proc String
c1 [String]
args1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Handle -> ProcessHandle -> IO String) -> IO String)
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
    \ Handle
ho1 ProcessHandle
p1 -> do
      (Maybe Handle
_, Maybe Handle
mho2, Maybe Handle
_, 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})
      case Maybe Handle
mho2 of
        Maybe Handle
Nothing -> String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"no stdout handle for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c2
        Just Handle
ho2 -> do
          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_ (String
c1,[String]
args1) (String
c2,[String]
args2) =
  IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ PipeCommand -> PipeCommand -> IO Bool
pipeBool (String
c1,[String]
args1) (String
c2,[String]
args2)

-- | Bool result of piping of commands
-- @since 0.2.0
-- Returns False if either command fails (since 0.2.4).
pipeBool :: PipeCommand -> PipeCommand -> IO Bool
pipeBool :: PipeCommand -> PipeCommand -> IO Bool
pipeBool (String
c1,[String]
args1) (String
c2,[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 Bool)
-> IO Bool
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 Bool)
 -> IO Bool)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Bool)
-> IO Bool
forall a b. (a -> b) -> a -> b
$
    \ Maybe Handle
_si Maybe Handle
so Maybe Handle
_se 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
      Bool
ok1 <- IO ExitCode -> IO Bool
boolWrapper (IO ExitCode -> IO Bool) -> IO ExitCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p1
      Bool
ok2 <- IO ExitCode -> IO Bool
boolWrapper (IO ExitCode -> IO Bool) -> IO ExitCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p2
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
ok1 Bool -> Bool -> Bool
&& Bool
ok2

-- | Pipe 3 commands, returning stdout
--
-- @since 0.2.3
pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String
pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String
pipe3 (String
c1,[String]
a1) (String
c2,[String]
a2) (String
c3,[String]
a3) =
  CreateProcess
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a.
CreateProcess -> (Handle -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput ((String -> [String] -> CreateProcess
proc String
c1 [String]
a1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Handle -> ProcessHandle -> IO String) -> IO String)
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
  \ Handle
ho1 ProcessHandle
p1 ->
    CreateProcess
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a.
CreateProcess -> (Handle -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput ((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}) ((Handle -> ProcessHandle -> IO String) -> IO String)
-> (Handle -> ProcessHandle -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
    \ Handle
ho2 ProcessHandle
p2 -> do
      (Maybe Handle
_, Just Handle
ho3, Maybe Handle
_, 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_ (String
c1,[String]
a1) (String
c2,[String]
a2) (String
c3,[String]
a3) =
  CreateProcess -> (Handle -> ProcessHandle -> IO ()) -> IO ()
forall a.
CreateProcess -> (Handle -> ProcessHandle -> IO a) -> IO a
withCreateProcessOutput ((String -> [String] -> CreateProcess
proc String
c1 [String]
a1) { std_out :: StdStream
std_out = StdStream
CreatePipe }) ((Handle -> ProcessHandle -> IO ()) -> IO ())
-> (Handle -> ProcessHandle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
  \ Handle
ho1 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
$
    \ Maybe Handle
_hi2 Maybe Handle
mho2 Maybe Handle
_he2 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
mho2 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_ String
infile (String
c1,[String]
a1) (String
c2,[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
$
  \ 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
$
    \ Maybe Handle
_si Maybe Handle
so Maybe Handle
_se 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 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
$ String
"missing program: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prog

-- FIXME handle empty extension?
-- | returns the files with the give extension
filesWithExtension :: FilePath -- directory
                   -> String   -- file extension
                   -> IO [FilePath]
filesWithExtension :: String -> String -> IO [String]
filesWithExtension String
dir String
ext =
  (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
ext String -> String -> Bool
`isExtensionOf`) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir

-- looks in dir for a unique file with given extension
fileWithExtension :: FilePath -- directory
                  -> String   -- file extension
                  -> IO (Maybe FilePath)
fileWithExtension :: String -> String -> IO (Maybe String)
fileWithExtension String
dir String
ext = do
  [String]
files <- String -> String -> IO [String]
filesWithExtension String
dir String
ext
  case [String]
files of
       [String
file] -> 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
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
file
       [] -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
       [String]
_ -> String -> IO ()
putStrLn (String
"More than one " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" file found!") IO () -> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

#if !MIN_VERSION_filepath(1,4,2)
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions
isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions
#endif

-- | Run an IO action and then print how long it took
timeIO :: IO a -> IO a
timeIO :: IO a -> IO a
timeIO IO a
action = do
  IO UTCTime -> (UTCTime -> IO ()) -> (UTCTime -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    IO UTCTime
getCurrentTime
    (\UTCTime
start -> do
        UTCTime
end <- IO UTCTime
getCurrentTime
        let duration :: NominalDiffTime
duration = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
end UTCTime
start
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"took " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NominalDiffTime -> String
forall a. (FormatTime a, Ord a, Num a) => a -> String
renderDuration NominalDiffTime
duration)
    (IO a -> UTCTime -> IO a
forall a b. a -> b -> a
const IO a
action)
  where
#if MIN_VERSION_time(1,9,0)
    renderDuration :: a -> String
renderDuration a
dur =
      let fmtstr :: String
fmtstr
            | a
dur a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
60 = String
"%s sec"
            | a
dur a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
3600 = String
"%m min %S sec"
            | Bool
otherwise = String
"%h hours %M min"
      in TimeLocale -> String -> a -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmtstr a
dur
#else
    renderDuration = show
#endif