diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for simple-cmd +## 0.1.3 -- 2019-02-20 +- gitDiffQuiet +- fix rwGitDir regexp +- use errorWithoutStackTrace + ## 0.1.2 -- 2018-10-28 - grep - improve haddock documentation diff --git a/SimpleCmd.hs b/SimpleCmd.hs --- a/SimpleCmd.hs +++ b/SimpleCmd.hs @@ -1,6 +1,6 @@ {-| Some simple String wrappers of `readProcess`, `readProcessWithExitCode`, -`rawSystem` from the Haskell `process` library. +`rawSystem` from the Haskell library. Simplest is @@ -16,7 +16,7 @@ returns stdout as a @String@. -There are also @cmdBool@, @cmdMaybe@, @cmdList@, @shell@, and others. +There are also @cmdBool@, @cmdMaybe@, @cmdLines@, @shell@, and others. Other examples: @@ -45,7 +45,7 @@ sudo, (+-+)) where -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) +#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>)) #endif @@ -66,6 +66,13 @@ 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 c args' runs a command in a process and returns stdout cmd :: String -- ^ command to run -> [String] -- ^ list of arguments @@ -78,7 +85,7 @@ ret <- rawSystem c args case ret of ExitSuccess -> return () - ExitFailure n -> error $ quoteCmd c args +-+ "failed with exit code" +-+ show n + ExitFailure n -> error' $ quoteCmd c args +-+ "failed with exit code" +-+ show n -- | 'cmdBool c args' runs a command, and return Boolean status cmdBool :: String -> [String] -> IO Bool @@ -136,13 +143,13 @@ (_ret, out, err) <- readProcessWithExitCode c args "" return (removeTrailingNewline out, removeTrailingNewline err) --- -- | 'cmdAssert msg c args' runs command, if it fails output msg as error. +-- -- | '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 +-- ExitFailure _ -> error' msg -- | 'cmdQuiet c args' runs a command hiding stderr, if it succeeds returns stdout cmdQuiet :: String -> [String] -> IO String @@ -150,7 +157,7 @@ (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 + ExitFailure n -> error' $ quoteCmd c args +-+ "failed with status" +-+ show n ++ "\n" ++ err -- | 'cmdSilent c args' runs a command hiding stdout: stderr is only output if it fails. cmdSilent :: String -> [String] -> IO () @@ -158,7 +165,7 @@ (ret, _, err) <- readProcessWithExitCode c args "" case ret of ExitSuccess -> return () - ExitFailure n -> error $ quoteCmd c args +-+ "failed with status" +-+ show n ++ "\n" ++ err + ExitFailure n -> error' $ quoteCmd c args +-+ "failed with status" +-+ show n ++ "\n" ++ err -- | 'cmdIgnoreErr c args inp' runs a command with input, drops stderr, and return stdout cmdIgnoreErr :: String -> [String] -> String -> IO String @@ -191,7 +198,7 @@ -> IO () sudo c args = cmdlog "sudo" (c:args) --- | Combine strings with a single space +-- | Combine two strings with a single space infixr 4 +-+ (+-+) :: String -> String -> String "" +-+ s = s @@ -209,10 +216,10 @@ removePrefix prefix orig = fromMaybe orig $ stripPrefix prefix orig --- | 'removeStrictPrefix prefix original' removes prefix, or fails with error +-- | '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 + fromMaybe (error' prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig -- | 'removeSuffix suffix original' removes suffix from string if present removeSuffix :: String -> String -> String diff --git a/SimpleCmd/Git.hs b/SimpleCmd/Git.hs --- a/SimpleCmd/Git.hs +++ b/SimpleCmd/Git.hs @@ -2,6 +2,7 @@ git, git_, gitBranch, + gitDiffQuiet, grepGitConfig, isGitDir, rwGitDir) where @@ -10,9 +11,9 @@ import System.Directory (doesDirectoryExist) import System.FilePath (()) -import SimpleCmd (cmd, cmd_, cmdLines, egrep_, removePrefix) +import SimpleCmd (cmd, cmd_, cmdBool, cmdLines, egrep_, removePrefix) -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) +#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>)) #endif @@ -41,7 +42,7 @@ -- | 'rwGitDir' checks if a git repo is under ssh rwGitDir :: IO Bool rwGitDir = - grepGitConfig "url = (ssh://|git@)" + grepGitConfig "url = \\(ssh://\\|git@\\)" -- | 'grepGitConfig pat' greps ".git/config" for extended regexp -- @@ -52,3 +53,9 @@ 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 diff --git a/simple-cmd.cabal b/simple-cmd.cabal --- a/simple-cmd.cabal +++ b/simple-cmd.cabal @@ -1,5 +1,5 @@ name: simple-cmd -version: 0.1.2 +version: 0.1.3 synopsis: Simple String-based process commands description: Thin wrappers over System.Process (readProcess, @@ -17,8 +17,8 @@ cabal-version: >=1.10 extra-source-files: README.md ChangeLog.md TODO tested-with: GHC == 7.0.4, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, - GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, - GHC == 8.6.1 + GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, + GHC == 8.6.3 source-repository head type: git