packages feed

simple-cmd 0.2.4 → 0.2.5

raw patch · 9 files changed

+610/−583 lines, 9 filesdep +time

Dependencies added: time

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Version history for simple-cmd +## 0.2.5 (2022-04-24)+- cmdN: quote arguments with show+- add timeIO: runs action and prints the time it took+ ## 0.2.4 (2022-03-27) - error' and warning are now strict - pipeBool: return False if either end fails
− SimpleCmd.hs 
@@ -1,482 +0,0 @@-{-# 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-  ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import Control.Monad.Extra--import Data.List (-#if !MIN_VERSION_filepath(1,4,2)-  isSuffixOf,-#endif-  stripPrefix)-import Data.Maybe (isJust, isNothing, fromMaybe)--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 "" = ""-removeTrailingNewline str =-  if last str == '\n'-  then init str-  else str--quoteCmd :: String -> [String] -> String-quoteCmd = 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' s = errorWithoutStackTrace $! 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 c args = cmdStdIn c args ""---- | @cmd_ c args@ runs command in a process, output goes to stdout and stderr-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--boolWrapper :: IO ExitCode -> IO Bool-boolWrapper pr = do-  ret <- pr-  case ret of-    ExitSuccess -> return True-    ExitFailure _ -> return False---- | @cmdBool c args@ runs a command, and return Boolean status-cmdBool :: String -> [String] -> IO Bool-cmdBool c args =-  boolWrapper (rawSystem c args)---- | @cmdMaybe c args@ runs a command, maybe returning output if it succeeds-cmdMaybe :: String -> [String] -> IO (Maybe String)-cmdMaybe c args = do-  (ok, out, _err) <- cmdFull c args ""-  return $ if ok then Just out else Nothing---- | @cmdLines c args@ runs a command, and returns list of stdout lines------ @since 0.1.1-cmdLines :: String -> [String] -> IO [String]-cmdLines c args = lines <$> cmd c args---- | @cmdStdIn c args inp@ runs a command, passing input string as stdin, and returns stdout-cmdStdIn :: String -> [String] -> String -> IO String-cmdStdIn c args inp = removeTrailingNewline <$> readProcess c args inp---- | @shell cs@ runs a command string in a shell, and returns stdout-shell :: String -> IO String-shell cs = cmd "sh" ["-c", cs]---- | @shell_ cs@ runs a command string in a shell, output goes to stdout-shell_ :: String -> IO ()-shell_ cs = cmd_ "sh" ["-c", cs]---- | @shellBool cs@ runs a command string in a shell, output goes to stdout------ @since 0.2.0-shellBool :: String -> IO Bool-shellBool cs =-  boolWrapper (rawSystem "sh" ["-c", cs])---- FIXME cmdLog_--- | @cmdLog c args@ logs a command with a datestamp------ @since 0.1.4-cmdLog :: String -> [String] -> IO ()-cmdLog c args = do-  logMsg $ unwords $ c:args-  cmd_ c args---- | @cmdlog@ deprecated alias for 'cmdLog' (will be removed in 0.3)-cmdlog :: String -> [String] -> IO ()-cmdlog = cmdLog---- | @logMsg msg@ outputs message with a timestamp-logMsg :: String -> IO ()-logMsg msg = do-  date <- cmd "date" ["+%T"]-  putStrLn $ date +-+ msg---- | @cmdN c args@ dry-runs a command: prints command to stdout - more used for debugging-cmdN :: String -> [String] -> IO ()-cmdN c args = putStrLn $ unwords $ c:args---- | @cmdStdErr c args@ runs command in a process, returning stdout and stderr-cmdStdErr :: String -> [String] -> IO (String, String)-cmdStdErr c args = do-  (_ok, out, err) <- cmdFull c args ""-  return (out, 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 c args = do-  (ok, out, err) <- cmdFull c args ""-  return $ if ok-    then out-    else error' $ quoteCmd c args +-+ "failed with\n" ++ err---- | @cmdSilent c args@ runs a command hiding stdout: stderr is only output if it fails.-cmdSilent :: String -> [String] -> IO ()-cmdSilent c args = do-  (ret, _, err) <- cmdFull c args ""-  unless ret $-    error' $ quoteCmd c args +-+ "failed with\n" ++ 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 c args input = do-  (_ret, out, _err) <- cmdFull c args input-  return 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 c args input = do-  (ret, out, err) <- readProcessWithExitCode c args input-  return (ret == ExitSuccess, removeTrailingNewline out, removeTrailingNewline err)---- | @cmdTry_ c args@ runs the command if available------ @since 0.2.1-cmdTry_ :: String -> [String] -> IO ()-cmdTry_ c args = do-  have <- findExecutable c-  when (isJust have) $-    cmd_ c args---- | Redirect stderr to stdout, ie with interleaved output------ @since 0.2.2-cmdStderrToStdout :: String -> [String] -> IO (ExitCode, String)-cmdStderrToStdout c args = do-  (_ , Just hout, _, p) <- createProcess ((proc c args)-                                          {std_out = CreatePipe,-                                           std_err = UseHandle stdout})-  ret <- waitForProcess p-  out <- hGetContents hout-  return (ret, removeTrailingNewline out)---- | Redirect stderr to stdout, ie with interleaved output------ @since 0.2.3-cmdStderrToStdoutIn :: String -> [String] -> String -> IO (Bool, String)-cmdStderrToStdoutIn c args inp = do-  (Just hin, Just hout, _, p) <- createProcess ((proc c args)-                                          {std_in  = CreatePipe,-                                           std_out = CreatePipe,-                                           std_err = UseHandle stdout})-  hPutStr hin inp-  ret <- waitForProcess p-  out <- hGetContents hout-  return (ret == ExitSuccess, removeTrailingNewline 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 pat file = do-  mres <- cmdMaybe "grep" [pat, file]-  return $ maybe [] lines mres---- | @grep_ pat file@ greps pattern in file and returns Boolean status-grep_ :: String -- ^ pattern-      -> FilePath -- ^ file-      -> IO Bool -- ^ result-grep_ pat file =-  cmdBool "grep" ["-q", pat, file]---- | @egrep_ pat file@ greps extended regexp in file, and returns Boolean status-egrep_ :: String -> FilePath -> IO Bool-egrep_ pat file =-  cmdBool "grep" ["-q", "-e", pat, 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 = sudoInternal cmd---- | @sudo_ c args@ runs a command as sudo------ @since 0.2.0-sudo_ :: String -- ^ command-     -> [String] -- ^ arguments-     -> IO ()-sudo_ = sudoInternal cmdLog--sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a-sudoInternal exc c args = do-  uid <- getEffectiveUserID-  sd <- if uid == 0-    then return Nothing-    else findExecutable "sudo"-  let noSudo = isNothing sd-  when (uid /= 0 && noSudo) $-    warning "'sudo' not found"-  exc (fromMaybe c sd) (if noSudo then args else c:args)---- | Combine two strings with a single space-infixr 4 +-+-(+-+) :: String -> String -> String-"" +-+ s = s-s +-+ "" = s-s +-+ t | last s == ' ' = s ++ t-        | head t == ' ' = s ++ t-s +-+ t = s ++ " " ++ t---- singleLine :: String -> String--- singleLine "" = ""--- singleLine s = (head . lines) s---- | @removePrefix prefix original@ removes prefix from string if present-removePrefix :: String -> String-> String-removePrefix prefix orig =-  fromMaybe orig $ stripPrefix prefix orig---- | @removeStrictPrefix prefix original@ removes prefix, or fails with error'-removeStrictPrefix :: String -> String -> String-removeStrictPrefix prefix orig =-  fromMaybe (error' prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig---- | @removeSuffix suffix original@ removes suffix from string if present-removeSuffix :: String -> String -> String-removeSuffix suffix orig =-  fromMaybe orig $ stripSuffix suffix orig-  where-    stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)---- | @warning@ outputs to stderr------ @since 0.2.0-warning :: String -> IO ()-warning s = hPutStrLn stderr $! 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 p act =-  withCreateProcess p $-    \ _si mso _se p' ->-      case mso of-        Nothing -> error $ "no stdout handle for: " ++ show (cmdspec p)-        Just so -> act so p'---- | Return stdout from piping the output of one process to another------ @since 0.2.0-pipe :: PipeCommand -> PipeCommand -> IO String-pipe (c1,args1) (c2,args2) =-  withCreateProcessOutput ((proc c1 args1) { std_out = CreatePipe }) $-    \ ho1 p1 -> do-      (_, mho2, _, p2) <- createProcess ((proc c2 args2) {std_in = UseHandle ho1, std_out = CreatePipe})-      case mho2 of-        Nothing -> error $ "no stdout handle for: " ++ c2-        Just ho2 -> do-          out <- hGetContents ho2-          void $ waitForProcess p1-          void $ waitForProcess p2-          return $ removeTrailingNewline out---- | Pipe two commands without returning anything------ @since 0.2.0-pipe_ :: PipeCommand -> PipeCommand -> IO ()-pipe_ (c1,args1) (c2,args2) =-  void $ pipeBool (c1,args1) (c2,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 (c1,args1) (c2,args2) =-  -- nicer with process-typed:-  -- withProcess_ (setStdout createPipe proc1) $ \ p -> runProcess (setStdin (useHandleClose (getStdout p)) proc2)-  withCreateProcess ((proc c1 args1) { std_out = CreatePipe }) $-    \ _si so _se p1 -> do-      p2 <- runProcess c2 args2 Nothing Nothing so Nothing Nothing-      ok1 <- boolWrapper $ waitForProcess p1-      ok2 <- boolWrapper $ waitForProcess p2-      return $ ok1 && ok2---- | Pipe 3 commands, returning stdout------ @since 0.2.3-pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String-pipe3 (c1,a1) (c2,a2) (c3,a3) =-  withCreateProcessOutput ((proc c1 a1) { std_out = CreatePipe }) $-  \ ho1 p1 ->-    withCreateProcessOutput ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $-    \ ho2 p2 -> do-      (_, Just ho3, _, p3) <- createProcess ((proc c3 a3) {std_in = UseHandle ho2, std_out = CreatePipe})-      out <- hGetContents ho3-      forM_ [p1,p2,p3] waitForProcess-      return $ removeTrailingNewline out---- | Pipe 3 commands, not returning anything------ @since 0.2.0-pipe3_ :: PipeCommand -> PipeCommand -> PipeCommand -> IO ()-pipe3_ (c1,a1) (c2,a2) (c3,a3) =-  withCreateProcessOutput ((proc c1 a1) { std_out = CreatePipe }) $-  \ ho1 p1 ->-    withCreateProcess ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $-    \ _hi2 mho2 _he2 p2 -> do-      p3 <- runProcess c3 a3 Nothing Nothing mho2 Nothing Nothing-      forM_ [p1,p2,p3] waitForProcess---- | Pipe a file to the first of a pipe of commands------ @since 0.2.0-pipeFile_ :: FilePath -> PipeCommand -> PipeCommand -> IO ()-pipeFile_ infile (c1,a1) (c2,a2) =-  withFile infile ReadMode $-  \ hin ->-    withCreateProcess ((proc c1 a1) { std_in = UseHandle hin, std_out = CreatePipe }) $-    \ _si so _se p1 -> do-      p2 <- runProcess c2 a2 Nothing Nothing so Nothing Nothing-      void $ waitForProcess p1-      void $ waitForProcess p2---- | Assert program in PATH------ @needProgram progname@------ @since 0.2.1-needProgram :: String -> IO ()-needProgram prog = do-  mx <- findExecutable prog-  unless (isJust mx) $ error' $ "missing program: " ++ prog---- FIXME handle empty extension?--- | returns the files with the give extension-filesWithExtension :: FilePath -- directory-                   -> String   -- file extension-                   -> IO [FilePath]-filesWithExtension dir ext =-  filter (ext `isExtensionOf`) <$> listDirectory dir---- looks in dir for a unique file with given extension-fileWithExtension :: FilePath -- directory-                  -> String   -- file extension-                  -> IO (Maybe FilePath)-fileWithExtension dir ext = do-  files <- filesWithExtension dir ext-  case files of-       [file] -> return $ Just $ dir </> file-       [] -> return Nothing-       _ -> putStrLn ("More than one " ++ ext ++ " file found!") >> return Nothing--#if !MIN_VERSION_filepath(1,4,2)-isExtensionOf :: String -> FilePath -> Bool-isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions-isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions-#endif
− SimpleCmd/Git.hs 
@@ -1,74 +0,0 @@-{-|-Some wrappers for git commands.--}--module SimpleCmd.Git (-  git,-  git_,-  gitBool,-  gitBranch,-  gitDiffQuiet,-  grepGitConfig,-  isGitDir,-  rwGitDir) where--import System.Directory (doesDirectoryExist)-import System.FilePath ((</>))--import SimpleCmd (cmd, cmd_, cmdBool, egrep_)--#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))-#else-import Control.Applicative ((<$>))-#endif---- | @git c args@ runs git command and return output-git :: String -- ^ git command-    -> [String] -- ^ arguments-    -> IO String -- ^ output-git c args =-  cmd "git" (c:args)---- | @git_ c args@ run git command with output to stdout and stderr-git_ :: String -> [String] -> IO ()-git_ c args =-  cmd_ "git" (c:args)---- | @gitBool c args@ runs git command and return result------ @since 0.2.2-gitBool :: String -- ^ git command-        -> [String] -- ^ arguments-        -> IO Bool -- ^ result-gitBool c args =-  cmdBool "git" (c:args)---- | @isGitDir dir@ checks if directory has a .git/ subdir-isGitDir :: FilePath -> IO Bool-isGitDir dir = doesDirectoryExist (dir </> ".git")---- | @gitBranch@ returns the git branch of the current directory-gitBranch :: IO String-gitBranch =-  git "rev-parse" ["--abbrev-ref", "HEAD"]---- | @rwGitDir@ checks if a git repo is under ssh-rwGitDir :: IO Bool-rwGitDir =-  grepGitConfig "url = \\(ssh://\\|git@\\)"---- | @grepGitConfig pat@ greps ".git/config" for extended regexp------ @since 0.1.1-grepGitConfig :: String -> IO Bool-grepGitConfig key = do-  gitdir <- isGitDir "."-  if gitdir-    then egrep_ key ".git/config"-    else return False---- | @gitDiffQuiet@ checks if unchanged------ @since 0.1.3-gitDiffQuiet :: [String] -> IO Bool-gitDiffQuiet args = cmdBool "git" $ ["diff", "--quiet"] ++ args
− SimpleCmd/Rpm.hs 
@@ -1,17 +0,0 @@-{-|-This Rpm module currently only provides @rpmspec@.--}--module SimpleCmd.Rpm (-  rpmspec-  ) where--import SimpleCmd (cmdLines)---- | @rpmspec args mqueryformat specfile@ runs rpmspec query on file with optional args (a newline is appended to any queryformat)------ @since 0.1.1-rpmspec :: [String] -> Maybe String -> FilePath -> IO [String]-rpmspec args mqf spec = do-  let qf = maybe [] (\ q -> ["--queryformat", q ++ "\n"]) mqf-  cmdLines "rpmspec" (["-q"] ++ args ++ qf ++ [spec])
simple-cmd.cabal view
@@ -1,5 +1,5 @@ name:                simple-cmd-version:             0.2.4+version:             0.2.5 synopsis:            Simple String-based process commands description:             Simple wrappers over System.Process@@ -30,11 +30,13 @@   exposed-modules:     SimpleCmd,                        SimpleCmd.Git,                        SimpleCmd.Rpm+  hs-source-dirs:      src   build-depends:       base < 5,-                       directory,+                       directory >= 1.2.5.0,                        extra,                        filepath,                        process >= 1.4.3.0,+                       time,                        unix   default-language:    Haskell2010   default-extensions:  CPP@@ -54,16 +56,16 @@     ghc-options:       -Wunused-packages  test-suite tests-    type:               exitcode-stdio-1.0-    hs-source-dirs:     test-    main-is:            Spec.hs-    build-depends:      hspec,-                        base < 5.0,-                        simple-cmd+    type:              exitcode-stdio-1.0+    hs-source-dirs:    test+    main-is:           Spec.hs+    build-depends:     hspec,+                       base < 5.0,+                       simple-cmd -    default-language:   Haskell2010+    default-language:  Haskell2010 -    ghc-options:        -Wall+    ghc-options:       -Wall   if impl(ghc >= 8.0)     ghc-options:       -Wcompat                        -Widentities
+ src/SimpleCmd.hs view
@@ -0,0 +1,496 @@+{-# 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++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 "" = ""+removeTrailingNewline str =+  if last str == '\n'+  then init str+  else str++quoteCmd :: String -> [String] -> String+quoteCmd = 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' s = errorWithoutStackTrace $! 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 c args = cmdStdIn c args ""++-- | @cmd_ c args@ runs command in a process, output goes to stdout and stderr+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++boolWrapper :: IO ExitCode -> IO Bool+boolWrapper pr = do+  ret <- pr+  case ret of+    ExitSuccess -> return True+    ExitFailure _ -> return False++-- | @cmdBool c args@ runs a command, and return Boolean status+cmdBool :: String -> [String] -> IO Bool+cmdBool c args =+  boolWrapper (rawSystem c args)++-- | @cmdMaybe c args@ runs a command, maybe returning output if it succeeds+cmdMaybe :: String -> [String] -> IO (Maybe String)+cmdMaybe c args = do+  (ok, out, _err) <- cmdFull c args ""+  return $ if ok then Just out else Nothing++-- | @cmdLines c args@ runs a command, and returns list of stdout lines+--+-- @since 0.1.1+cmdLines :: String -> [String] -> IO [String]+cmdLines c args = lines <$> cmd c args++-- | @cmdStdIn c args inp@ runs a command, passing input string as stdin, and returns stdout+cmdStdIn :: String -> [String] -> String -> IO String+cmdStdIn c args inp = removeTrailingNewline <$> readProcess c args inp++-- | @shell cs@ runs a command string in a shell, and returns stdout+shell :: String -> IO String+shell cs = cmd "sh" ["-c", cs]++-- | @shell_ cs@ runs a command string in a shell, output goes to stdout+shell_ :: String -> IO ()+shell_ cs = cmd_ "sh" ["-c", cs]++-- | @shellBool cs@ runs a command string in a shell, output goes to stdout+--+-- @since 0.2.0+shellBool :: String -> IO Bool+shellBool cs =+  boolWrapper (rawSystem "sh" ["-c", cs])++-- FIXME cmdLog_+-- | @cmdLog c args@ logs a command with a datestamp+--+-- @since 0.1.4+cmdLog :: String -> [String] -> IO ()+cmdLog c args = do+  logMsg $ unwords $ c:args+  cmd_ c args++-- | @cmdlog@ deprecated alias for 'cmdLog' (will be removed in 0.3)+cmdlog :: String -> [String] -> IO ()+cmdlog = cmdLog++-- | @logMsg msg@ outputs message with a timestamp+logMsg :: String -> IO ()+logMsg msg = do+  date <- cmd "date" ["+%T"]+  putStrLn $ date +-+ msg++-- | @cmdN c args@ dry-runs a command: prints command to stdout - more used for debugging+cmdN :: String -> [String] -> IO ()+cmdN c args = putStrLn $ unwords $ c : map show args++-- | @cmdStdErr c args@ runs command in a process, returning stdout and stderr+cmdStdErr :: String -> [String] -> IO (String, String)+cmdStdErr c args = do+  (_ok, out, err) <- cmdFull c args ""+  return (out, 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 c args = do+  (ok, out, err) <- cmdFull c args ""+  return $ if ok+    then out+    else error' $ quoteCmd c args +-+ "failed with\n" ++ err++-- | @cmdSilent c args@ runs a command hiding stdout: stderr is only output if it fails.+cmdSilent :: String -> [String] -> IO ()+cmdSilent c args = do+  (ret, _, err) <- cmdFull c args ""+  unless ret $+    error' $ quoteCmd c args +-+ "failed with\n" ++ 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 c args input = do+  (_ret, out, _err) <- cmdFull c args input+  return 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 c args input = do+  (ret, out, err) <- readProcessWithExitCode c args input+  return (ret == ExitSuccess, removeTrailingNewline out, removeTrailingNewline err)++-- | @cmdTry_ c args@ runs the command if available+--+-- @since 0.2.1+cmdTry_ :: String -> [String] -> IO ()+cmdTry_ c args = do+  have <- findExecutable c+  when (isJust have) $+    cmd_ c args++-- | Redirect stderr to stdout, ie with interleaved output+--+-- @since 0.2.2+cmdStderrToStdout :: String -> [String] -> IO (ExitCode, String)+cmdStderrToStdout c args = do+  (_ , Just hout, _, p) <- createProcess ((proc c args)+                                          {std_out = CreatePipe,+                                           std_err = UseHandle stdout})+  ret <- waitForProcess p+  out <- hGetContents hout+  return (ret, removeTrailingNewline out)++-- | Redirect stderr to stdout, ie with interleaved output+--+-- @since 0.2.3+cmdStderrToStdoutIn :: String -> [String] -> String -> IO (Bool, String)+cmdStderrToStdoutIn c args inp = do+  (Just hin, Just hout, _, p) <- createProcess ((proc c args)+                                          {std_in  = CreatePipe,+                                           std_out = CreatePipe,+                                           std_err = UseHandle stdout})+  hPutStr hin inp+  ret <- waitForProcess p+  out <- hGetContents hout+  return (ret == ExitSuccess, removeTrailingNewline 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 pat file = do+  mres <- cmdMaybe "grep" [pat, file]+  return $ maybe [] lines mres++-- | @grep_ pat file@ greps pattern in file and returns Boolean status+grep_ :: String -- ^ pattern+      -> FilePath -- ^ file+      -> IO Bool -- ^ result+grep_ pat file =+  cmdBool "grep" ["-q", pat, file]++-- | @egrep_ pat file@ greps extended regexp in file, and returns Boolean status+egrep_ :: String -> FilePath -> IO Bool+egrep_ pat file =+  cmdBool "grep" ["-q", "-e", pat, 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 = sudoInternal cmd++-- | @sudo_ c args@ runs a command as sudo+--+-- @since 0.2.0+sudo_ :: String -- ^ command+     -> [String] -- ^ arguments+     -> IO ()+sudo_ = sudoInternal cmdLog++sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a+sudoInternal exc c args = do+  uid <- getEffectiveUserID+  sd <- if uid == 0+    then return Nothing+    else findExecutable "sudo"+  let noSudo = isNothing sd+  when (uid /= 0 && noSudo) $+    warning "'sudo' not found"+  exc (fromMaybe c sd) (if noSudo then args else c:args)++-- | Combine two strings with a single space+infixr 4 +-++(+-+) :: String -> String -> String+"" +-+ s = s+s +-+ "" = s+s +-+ t | last s == ' ' = s ++ t+        | head t == ' ' = s ++ t+s +-+ t = s ++ " " ++ t++-- singleLine :: String -> String+-- singleLine "" = ""+-- singleLine s = (head . lines) s++-- | @removePrefix prefix original@ removes prefix from string if present+removePrefix :: String -> String-> String+removePrefix prefix orig =+  fromMaybe orig $ stripPrefix prefix orig++-- | @removeStrictPrefix prefix original@ removes prefix, or fails with error'+removeStrictPrefix :: String -> String -> String+removeStrictPrefix prefix orig =+  fromMaybe (error' prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig++-- | @removeSuffix suffix original@ removes suffix from string if present+removeSuffix :: String -> String -> String+removeSuffix suffix orig =+  fromMaybe orig $ stripSuffix suffix orig+  where+    stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)++-- | @warning@ outputs to stderr+--+-- @since 0.2.0+warning :: String -> IO ()+warning s = hPutStrLn stderr $! 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 p act =+  withCreateProcess p $+    \ _si mso _se p' ->+      case mso of+        Nothing -> error $ "no stdout handle for: " ++ show (cmdspec p)+        Just so -> act so p'++-- | Return stdout from piping the output of one process to another+--+-- @since 0.2.0+pipe :: PipeCommand -> PipeCommand -> IO String+pipe (c1,args1) (c2,args2) =+  withCreateProcessOutput ((proc c1 args1) { std_out = CreatePipe }) $+    \ ho1 p1 -> do+      (_, mho2, _, p2) <- createProcess ((proc c2 args2) {std_in = UseHandle ho1, std_out = CreatePipe})+      case mho2 of+        Nothing -> error $ "no stdout handle for: " ++ c2+        Just ho2 -> do+          out <- hGetContents ho2+          void $ waitForProcess p1+          void $ waitForProcess p2+          return $ removeTrailingNewline out++-- | Pipe two commands without returning anything+--+-- @since 0.2.0+pipe_ :: PipeCommand -> PipeCommand -> IO ()+pipe_ (c1,args1) (c2,args2) =+  void $ pipeBool (c1,args1) (c2,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 (c1,args1) (c2,args2) =+  -- nicer with process-typed:+  -- withProcess_ (setStdout createPipe proc1) $ \ p -> runProcess (setStdin (useHandleClose (getStdout p)) proc2)+  withCreateProcess ((proc c1 args1) { std_out = CreatePipe }) $+    \ _si so _se p1 -> do+      p2 <- runProcess c2 args2 Nothing Nothing so Nothing Nothing+      ok1 <- boolWrapper $ waitForProcess p1+      ok2 <- boolWrapper $ waitForProcess p2+      return $ ok1 && ok2++-- | Pipe 3 commands, returning stdout+--+-- @since 0.2.3+pipe3 :: PipeCommand -> PipeCommand -> PipeCommand -> IO String+pipe3 (c1,a1) (c2,a2) (c3,a3) =+  withCreateProcessOutput ((proc c1 a1) { std_out = CreatePipe }) $+  \ ho1 p1 ->+    withCreateProcessOutput ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $+    \ ho2 p2 -> do+      (_, Just ho3, _, p3) <- createProcess ((proc c3 a3) {std_in = UseHandle ho2, std_out = CreatePipe})+      out <- hGetContents ho3+      forM_ [p1,p2,p3] waitForProcess+      return $ removeTrailingNewline out++-- | Pipe 3 commands, not returning anything+--+-- @since 0.2.0+pipe3_ :: PipeCommand -> PipeCommand -> PipeCommand -> IO ()+pipe3_ (c1,a1) (c2,a2) (c3,a3) =+  withCreateProcessOutput ((proc c1 a1) { std_out = CreatePipe }) $+  \ ho1 p1 ->+    withCreateProcess ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $+    \ _hi2 mho2 _he2 p2 -> do+      p3 <- runProcess c3 a3 Nothing Nothing mho2 Nothing Nothing+      forM_ [p1,p2,p3] waitForProcess++-- | Pipe a file to the first of a pipe of commands+--+-- @since 0.2.0+pipeFile_ :: FilePath -> PipeCommand -> PipeCommand -> IO ()+pipeFile_ infile (c1,a1) (c2,a2) =+  withFile infile ReadMode $+  \ hin ->+    withCreateProcess ((proc c1 a1) { std_in = UseHandle hin, std_out = CreatePipe }) $+    \ _si so _se p1 -> do+      p2 <- runProcess c2 a2 Nothing Nothing so Nothing Nothing+      void $ waitForProcess p1+      void $ waitForProcess p2++-- | Assert program in PATH+--+-- @needProgram progname@+--+-- @since 0.2.1+needProgram :: String -> IO ()+needProgram prog = do+  mx <- findExecutable prog+  unless (isJust mx) $ error' $ "missing program: " ++ prog++-- FIXME handle empty extension?+-- | returns the files with the give extension+filesWithExtension :: FilePath -- directory+                   -> String   -- file extension+                   -> IO [FilePath]+filesWithExtension dir ext =+  filter (ext `isExtensionOf`) <$> listDirectory dir++-- looks in dir for a unique file with given extension+fileWithExtension :: FilePath -- directory+                  -> String   -- file extension+                  -> IO (Maybe FilePath)+fileWithExtension dir ext = do+  files <- filesWithExtension dir ext+  case files of+       [file] -> return $ Just $ dir </> file+       [] -> return Nothing+       _ -> putStrLn ("More than one " ++ ext ++ " file found!") >> return 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 action = do+  bracket+    getCurrentTime+    (\start -> do+        end <- getCurrentTime+        let duration = diffUTCTime end start+        putStrLn $ "took " ++ show duration)+    (const action)
+ src/SimpleCmd/Git.hs view
@@ -0,0 +1,74 @@+{-|+Some wrappers for git commands.+-}++module SimpleCmd.Git (+  git,+  git_,+  gitBool,+  gitBranch,+  gitDiffQuiet,+  grepGitConfig,+  isGitDir,+  rwGitDir) where++import System.Directory (doesDirectoryExist)+import System.FilePath ((</>))++import SimpleCmd (cmd, cmd_, cmdBool, egrep_)++#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))+#else+import Control.Applicative ((<$>))+#endif++-- | @git c args@ runs git command and return output+git :: String -- ^ git command+    -> [String] -- ^ arguments+    -> IO String -- ^ output+git c args =+  cmd "git" (c:args)++-- | @git_ c args@ run git command with output to stdout and stderr+git_ :: String -> [String] -> IO ()+git_ c args =+  cmd_ "git" (c:args)++-- | @gitBool c args@ runs git command and return result+--+-- @since 0.2.2+gitBool :: String -- ^ git command+        -> [String] -- ^ arguments+        -> IO Bool -- ^ result+gitBool c args =+  cmdBool "git" (c:args)++-- | @isGitDir dir@ checks if directory has a .git/ subdir+isGitDir :: FilePath -> IO Bool+isGitDir dir = doesDirectoryExist (dir </> ".git")++-- | @gitBranch@ returns the git branch of the current directory+gitBranch :: IO String+gitBranch =+  git "rev-parse" ["--abbrev-ref", "HEAD"]++-- | @rwGitDir@ checks if a git repo is under ssh+rwGitDir :: IO Bool+rwGitDir =+  grepGitConfig "url = \\(ssh://\\|git@\\)"++-- | @grepGitConfig pat@ greps ".git/config" for extended regexp+--+-- @since 0.1.1+grepGitConfig :: String -> IO Bool+grepGitConfig key = do+  gitdir <- isGitDir "."+  if gitdir+    then egrep_ key ".git/config"+    else return False++-- | @gitDiffQuiet@ checks if unchanged+--+-- @since 0.1.3+gitDiffQuiet :: [String] -> IO Bool+gitDiffQuiet args = cmdBool "git" $ ["diff", "--quiet"] ++ args
+ src/SimpleCmd/Rpm.hs view
@@ -0,0 +1,17 @@+{-|+This Rpm module currently only provides @rpmspec@.+-}++module SimpleCmd.Rpm (+  rpmspec+  ) where++import SimpleCmd (cmdLines)++-- | @rpmspec args mqueryformat specfile@ runs rpmspec query on file with optional args (a newline is appended to any queryformat)+--+-- @since 0.1.1+rpmspec :: [String] -> Maybe String -> FilePath -> IO [String]+rpmspec args mqf spec = do+  let qf = maybe [] (\ q -> ["--queryformat", q ++ "\n"]) mqf+  cmdLines "rpmspec" (["-q"] ++ args ++ qf ++ [spec])
test/Spec.hs view
@@ -23,7 +23,14 @@       out <- cmdLines "echo" ["1\n2"]       out `shouldBe` ["1","2"] +    it "cmdN" $+      cmdN "ls" ["*"]+   describe "pipes" $ do     it "pipe" $ do       out <- pipe ("echo", ["hello"]) ("grep",["hello"])       out `shouldBe` "hello"++  describe "timeIO" $ do+    it "sleep" $+      timeIO $ cmd_ "sleep" ["1"]