module SimpleCmd (
cmd, cmd_,
cmdBool,
cmdIgnoreErr,
cmdLines,
cmdlog,
cmdMaybe,
cmdN,
cmdQuiet,
cmdSilent,
cmdStdIn,
cmdStdErr,
egrep_, grep_,
logMsg,
removePrefix, removeStrictPrefix, removeSuffix,
shell, shell_,
sudo,
(+-+)) where
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import System.Exit (ExitCode (..))
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) ++ "'"
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
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 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 = cmdlog "sudo" (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)