module SimpleCmd (
cmd, cmd_,
cmdBool,
cmdIgnoreErr,
cmdLines,
cmdMaybe,
cmdLog, cmdlog ,
cmdN,
cmdQuiet,
cmdSilent,
cmdStdIn,
cmdStdErr,
error',
egrep_, grep, grep_,
logMsg,
removePrefix, removeStrictPrefix, removeSuffix,
shell, shell_,
sudo,
(+-+)) where
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad (when)
import Data.List (stripPrefix)
import Data.Maybe (isNothing, fromMaybe)
import System.Directory (findExecutable)
import System.Exit (ExitCode (..))
import System.IO (hPutStrLn, stderr)
import System.Posix.User (getEffectiveUserID)
import System.Process (readProcess, readProcessWithExitCode, rawSystem)
removeTrailingNewline :: String -> String
removeTrailingNewline "" = ""
removeTrailingNewline str =
if last str == '\n'
then init str
else str
quoteCmd :: String -> [String] -> String
quoteCmd c args = "'" ++ unwords (c:args) ++ "'"
error' :: String -> a
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0))
error' = errorWithoutStackTrace
#else
error' = error
#endif
cmd :: String
-> [String]
-> IO String
cmd c args = cmdStdIn c args ""
cmd_ :: String -> [String] -> IO ()
cmd_ c args = do
ret <- rawSystem c args
case ret of
ExitSuccess -> return ()
ExitFailure n -> error' $ quoteCmd c args +-+ "failed with exit code" +-+ show n
cmdBool :: String -> [String] -> IO Bool
cmdBool c args = do
ret <- rawSystem c args
case ret of
ExitSuccess -> return True
ExitFailure _ -> return False
cmdMaybe :: String -> [String] -> IO (Maybe String)
cmdMaybe c args = do
(ret, out, _err) <- readProcessWithExitCode c args ""
case ret of
ExitSuccess -> return $ Just $ removeTrailingNewline out
ExitFailure _ -> return Nothing
cmdLines :: String -> [String] -> IO [String]
cmdLines c args = lines <$> cmd c args
cmdStdIn :: String -> [String] -> String -> IO String
cmdStdIn c args inp = removeTrailingNewline <$> readProcess c args inp
shell :: String -> IO String
shell cs = cmd "sh" ["-c", cs]
shell_ :: String -> IO ()
shell_ c = cmd_ "sh" ["-c", c]
cmdLog :: String -> [String] -> IO ()
cmdLog c args = do
logMsg $ unwords $ c:args
cmd_ c args
cmdlog :: String -> [String] -> IO ()
cmdlog = cmdLog
logMsg :: String -> IO ()
logMsg msg = do
date <- cmd "date" ["+%T"]
putStrLn $ date +-+ msg
cmdN :: String -> [String] -> IO ()
cmdN c args = putStrLn $ unwords $ c:args
cmdStdErr :: String -> [String] -> IO (String, String)
cmdStdErr c args = do
(_ret, out, err) <- readProcessWithExitCode c args ""
return (removeTrailingNewline out, removeTrailingNewline err)
cmdQuiet :: String -> [String] -> IO String
cmdQuiet c args = do
(ret, out, err) <- readProcessWithExitCode c args ""
case ret of
ExitSuccess -> return $removeTrailingNewline out
ExitFailure n -> error' $ quoteCmd c args +-+ "failed with status" +-+ show n ++ "\n" ++ err
cmdSilent :: String -> [String] -> IO ()
cmdSilent c args = do
(ret, _, err) <- readProcessWithExitCode c args ""
case ret of
ExitSuccess -> return ()
ExitFailure n -> error' $ quoteCmd c args +-+ "failed with status" +-+ show n ++ "\n" ++ err
cmdIgnoreErr :: String -> [String] -> String -> IO String
cmdIgnoreErr c args input = do
(_exit, out, _err) <- readProcessWithExitCode c args input
return out
grep :: String -> FilePath -> IO [String]
grep pat file =
cmdLines "grep" [pat, file]
grep_ :: String
-> FilePath
-> IO Bool
grep_ pat file =
cmdBool "grep" ["-q", pat, file]
egrep_ :: String -> FilePath -> IO Bool
egrep_ pat file =
cmdBool "grep" ["-q", "-e", pat, file]
sudo :: String
-> [String]
-> IO ()
sudo c args = do
uid <- getEffectiveUserID
sd <- if uid == 0
then return Nothing
else findExecutable "sudo"
let noSudo = isNothing sd
when (uid /= 0 && noSudo) $
hPutStrLn stderr "'sudo' not found"
cmdLog (fromMaybe c sd) (if noSudo then args else c:args)
infixr 4 +-+
(+-+) :: String -> String -> String
"" +-+ s = s
s +-+ "" = s
s +-+ t | last s == ' ' = s ++ t
| head t == ' ' = s ++ t
s +-+ t = s ++ " " ++ t
removePrefix :: String -> String-> String
removePrefix prefix orig =
fromMaybe orig $ stripPrefix prefix orig
removeStrictPrefix :: String -> String -> String
removeStrictPrefix prefix orig =
fromMaybe (error' prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig
removeSuffix :: String -> String -> String
removeSuffix suffix orig =
fromMaybe orig $ stripSuffix suffix orig
where
stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)