simple-cmd (empty) → 0.1.0.0

raw patch · 8 files changed

+310/−0 lines, 8 filesdep +basedep +directorydep +filepathsetup-changed

Dependencies added: base, directory, filepath, process

Files

• ChangeLog.md +15/−0
• LICENSE +30/−0
• README.md +11/−0
• Setup.hs +2/−0
• SimpleCmd.hs +173/−0
• SimpleCmd/Git.hs +45/−0
• TODO +2/−0
• simple-cmd.cabal +32/−0

@@ -0,0 +1,15 @@+# Revision history for simple-cmd++## 0.1.0.0  -- 2018-09-13++- Initial release, providing:+  cmd, cmd_, cmdBool, cmdMaybe, cmdStdIn, cmdlog, cmdN,+  cmdIgnoreErr, cmdQuiet, cmdSilent, cmdStdErr,+  egrep_, grep_, logMsg,+  removePrefix, removeStrictPrefix, removeSuffix,+  shell, shell_, sudo, (+-+)+- A few git commands++# Local Variables:+# mode: text+# End:

@@ -0,0 +1,30 @@+Copyright (c) 2017, Jens Petersen++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jens Petersen nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,11 @@+[![Build Status](https://travis-ci.org/juhp/simple-cmd.png)](https://travis-ci.org/juhp/simple-cmd)++# simple-cmd++Some simple String wrappers of `readProcess`, `readProcessWithExitCode`,+`rawSystem` from the Haskell `process` library.++It can also be used as a copy library.++## Examples+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,173 @@+module SimpleCmd (+  cmd, cmd_,+  cmdBool,+  cmdIgnoreErr,+  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) ++ "'"++-- | Run a command in a process and return stdout+cmd :: String -> [String] -> IO String+cmd c args = cmdStdIn c args ""++-- | Run command in 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++-- | Run a command, and return Boolean status+cmdBool :: String -> [String] -> IO Bool+cmdBool c args = do+  ret <- rawSystem c args+  case ret of+    ExitSuccess -> return True+    ExitFailure _ -> return False++-- | Run a command in a process, maybe returning output if it succeeds+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++-- | Run a command, passing input string as stdin, and return stdout+cmdStdIn :: String -> [String] -> String -> IO String+cmdStdIn c args inp = removeTrailingNewline <$> readProcess c args inp++-- | Run a command string in a shell, and return stdout+shell :: String -> IO String+shell cs = cmd "sh" ["-c", cs]++-- | Run a command string in a shell, output goes to stdout+shell_ :: String -> IO ()+shell_ c = cmd_ "sh" ["-c", c]++-- | Log a command with a datestamp+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++-- | Dry-run a command: print it to stdout - more used for debugging+cmdN :: String -> [String] -> IO ()+cmdN c args = putStrLn $ unwords $ c:args++-- | Run command in a process, returning stdout and stderr+cmdStdErr :: String -> [String] -> IO (String, String)+cmdStdErr c args = do+  (_ret, out, err) <- readProcessWithExitCode c args ""+  return (removeTrailingNewline out, removeTrailingNewline err)++-- -- | Run 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++-- | Run a command hiding stderr, if it succeeds return stdout+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++-- | Run a command hiding stdout: stderr is only output if it fails.+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++-- | Run a command, drop stderr, and return stdout+cmdIgnoreErr :: String -> [String] -> String -> IO String+cmdIgnoreErr c args input = do+  (_exit, out, _err) <- readProcessWithExitCode c args input+  return out++-- | grep a pattern in file and return Boolean status+grep_ :: String -> FilePath -> IO Bool+grep_ pat file =+  cmdBool "grep" ["-q", pat, file]++-- | grep for extended regexp in file, and return Boolean status+egrep_ :: String -> FilePath -> IO Bool+egrep_ pat file =+  cmdBool "grep" ["-q", "-e", pat, file]++-- | sudo a command+sudo :: String -> [String] -> IO ()+sudo c args = cmdlog "sudo" (c:args)++-- | Combine 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++-- | Remove a prefix from a string if there+removePrefix :: String -> String-> String+removePrefix prefix orig =+  fromMaybe orig $ stripPrefix prefix orig++-- | Remove prefix, or fail with error+removeStrictPrefix :: String -> String -> String+removeStrictPrefix prefix orig =+  fromMaybe (error prefix +-+ "is not prefix of" +-+ orig) $ stripPrefix prefix orig++-- | Remove a suffix from a string if there+removeSuffix :: String -> String -> String+removeSuffix suffix orig =+  fromMaybe orig $ stripSuffix suffix orig+  where+    stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)

@@ -0,0 +1,45 @@+module SimpleCmd.Git (+  git,+  git_,+  gitBranch,+  isGitDir,+  rwGitDir) where++import Data.List (isPrefixOf)+import System.Directory (doesDirectoryExist, getCurrentDirectory)+import System.FilePath ((</>))++import SimpleCmd (cmd, cmd_, egrep_, removePrefix)++#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))+#else+import Control.Applicative ((<$>))+#endif++-- | Run git command and return output+git :: String -> [String] -> IO String+git c args =+  cmd "git" (c:args)++-- | Run git command with output to stdout and stderr+git_ :: String -> [String] -> IO ()+git_ c args =+  cmd_ "git" (c:args)++-- | Check if directory has a .git/ dir+isGitDir :: FilePath -> IO Bool+isGitDir dir = doesDirectoryExist (dir </> ".git")++-- | Return the git branch of the current directory+gitBranch :: IO String+gitBranch =+  removePrefix "* " . head . filter (isPrefixOf "* ") . lines <$> cmd "git" ["branch"]++-- | Check if a git repo is under ssh+rwGitDir :: IO Bool+rwGitDir = do+  gitDir <- getCurrentDirectory >>= isGitDir+  if gitDir+    then egrep_ "url = (ssh://|git@)" ".git/config"+    else return False+

@@ -0,0 +1,2 @@+- documentation+- examples

@@ -0,0 +1,32 @@+name:                simple-cmd+version:             0.1.0.0+synopsis:            Simple String-based process commands+description:+            Thin wrappers over the System.Process (readProcess,+            readProcessWithExitCode, and rawSystem). The idea is just+            to provide some simple common idioms for easy calling out+            to commands from programs.  For proper shell-scripting+            please use turtle, shelly, command, etc.+license:             BSD3+license-file:        LICENSE+author:              Jens Petersen+maintainer:          juhpetersen@gmail.com+copyright:           Jens Petersen <juhpetersen@gmail.com>+category:            System+build-type:          Simple+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++source-repository head+  type:     git+  location: https://github.com/juhp/simple-cmd++library+  exposed-modules:     SimpleCmd,+                       SimpleCmd.Git+  build-depends:       base < 5, directory, filepath, process+  default-language:    Haskell2010+  default-extensions:  CPP+  ghc-options:   -fwarn-missing-signatures -Wall