diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Version history for simple-cmd +## 0.2.4 (2022-03-27) +- error' and warning are now strict +- pipeBool: return False if either end fails +- add filesWithExtension and fileWithExtension +- initial basic testsuite + ## 0.2.3 (2020-12-20) - most commands now use removeTrailingNewline - cmdFull: wrapper of readProcessWithExitCode diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,3 @@ -[![Build Status](https://travis-ci.org/juhp/simple-cmd.png)](https://travis-ci.com/juhp/simple-cmd) [![Hackage](http://img.shields.io/hackage/v/simple-cmd.png)](http://hackage.haskell.org/package/simple-cmd) [![Stackage LTS](http://stackage.org/package/simple-cmd/badge/lts)](http://stackage.org/lts/package/simple-cmd) [![Stackage Nightly](http://stackage.org/package/simple-cmd/badge/nightly)](http://stackage.org/nightly/package/simple-cmd) @@ -40,6 +39,7 @@ ```haskell pipe_ ("echo",["hello"]) ("grep",["ello"]) ``` +`pipeBool` returns True if both commands succeed. Other examples: ```haskell diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/SimpleCmd.hs b/SimpleCmd.hs --- a/SimpleCmd.hs +++ b/SimpleCmd.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-| Some simple String wrappers of `readProcess`, `readProcessWithExitCode`, `rawSystem` from the Haskell library. @@ -42,39 +44,49 @@ cmdTry_, cmdStderrToStdout, cmdStderrToStdoutIn, + needProgram, error', - egrep_, grep, grep_, - ifM, + warning, logMsg, - needProgram, + (+-+), removePrefix, removeStrictPrefix, removeSuffix, + egrep_, grep, grep_, shell, shell_, shellBool, sudo, sudo_, - warning, PipeCommand, pipe, pipe_, pipeBool, pipe3, pipe3_, pipeFile_, + ifM, whenM, - (+-+)) where + filesWithExtension, + fileWithExtension + ) where -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) -#else +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad.Extra -import Data.List (stripPrefix) +import Data.List ( +#if !MIN_VERSION_filepath(1,4,2) + isSuffixOf, +#endif + stripPrefix) import Data.Maybe (isJust, isNothing, fromMaybe) -import System.Directory (findExecutable) +import System.Directory (findExecutable, listDirectory) import System.Exit (ExitCode (..)) +import System.FilePath import System.IO (hGetContents, hPutStr, hPutStrLn, IOMode(ReadMode), - stderr, stdout, withFile) + stderr, stdout, withFile, Handle) import System.Posix.User (getEffectiveUserID) -import System.Process (createProcess, proc, ProcessHandle, rawSystem, readProcess, +import System.Process (createProcess, CreateProcess (cmdspec), proc, + ProcessHandle, + rawSystem, readProcess, readProcessWithExitCode, runProcess, showCommandForUser, - std_err, std_in, std_out, StdStream(CreatePipe, UseHandle), + std_err, std_in, std_out, + StdStream(CreatePipe, UseHandle), waitForProcess, withCreateProcess) removeTrailingNewline :: String -> String @@ -92,9 +104,9 @@ -- @since 0.1.4 error' :: String -> a #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0)) -error' = errorWithoutStackTrace +error' s = errorWithoutStackTrace $! s #else -error' = error +error' s = error $! s #endif -- | @cmd c args@ runs a command in a process and returns stdout @@ -342,7 +354,7 @@ -- -- @since 0.2.0 warning :: String -> IO () -warning = hPutStrLn stderr +warning s = hPutStrLn stderr $! s -- | Type alias for a command in a pipe @@ -350,52 +362,60 @@ -- @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) = - withCreateProcess ((proc c1 args1) { std_out = CreatePipe }) $ - \ _si (Just ho1) _se p1 -> do - (_, Just ho2, _, p2) <- createProcess ((proc c2 args2) {std_in = UseHandle ho1, std_out = CreatePipe}) - out <- hGetContents ho2 - void $ waitForProcess p1 - void $ waitForProcess p2 - return $ removeTrailingNewline out + 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 $ pipeInternal (c1,args1) (c2,args2) >>= waitForProcess + 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) = - boolWrapper $ pipeInternal (c1,args1) (c2,args2) >>= waitForProcess - -pipeInternal :: PipeCommand -> PipeCommand -> IO ProcessHandle -pipeInternal (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 - void $ waitForProcess p1 - return p2 + 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) = - withCreateProcess ((proc c1 a1) { std_out = CreatePipe }) $ - \ _hi1 (Just ho1) _he1 p1 -> - withCreateProcess ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $ - \ _hi2 (Just ho2) _he2 p2 -> do + 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 @@ -406,11 +426,11 @@ -- @since 0.2.0 pipe3_ :: PipeCommand -> PipeCommand -> PipeCommand -> IO () pipe3_ (c1,a1) (c2,a2) (c3,a3) = - withCreateProcess ((proc c1 a1) { std_out = CreatePipe }) $ - \ _hi1 (Just ho1) _he1 p1 -> + withCreateProcessOutput ((proc c1 a1) { std_out = CreatePipe }) $ + \ ho1 p1 -> withCreateProcess ((proc c2 a2) {std_in = UseHandle ho1, std_out = CreatePipe}) $ - \ _hi2 ho2 _he2 p2 -> do - p3 <- runProcess c3 a3 Nothing Nothing ho2 Nothing Nothing + \ _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 @@ -435,3 +455,28 @@ 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 diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,6 @@ - source headers - examples + +# 0.3+ - add cmdLog_ (api break) +- use Proc for pipes 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.2.3 +version: 0.2.4 synopsis: Simple String-based process commands description: Simple wrappers over System.Process @@ -9,16 +9,18 @@ use turtle, shelly, command, etc. license: BSD3 license-file: LICENSE -author: Jens Petersen -maintainer: juhpetersen@gmail.com -copyright: 2017-2020 Jens Petersen +author: Jens Petersen +maintainer: Jens Petersen +copyright: 2017-2022 Jens Petersen category: System +homepage: https://github.com/juhp/simple-cmd +bug-reports: https://github.com/juhp/simple-cmd/issues build-type: Simple cabal-version: >=1.10 extra-source-files: README.md ChangeLog.md TODO tested-with: 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.4, GHC == 8.6.5, - GHC == 8.8.3, GHC == 8.10.1 + GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2 source-repository head type: git @@ -36,4 +38,42 @@ unix default-language: Haskell2010 default-extensions: CPP - ghc-options: -fwarn-missing-signatures -Wall + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + 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 + + default-language: Haskell2010 + + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,29 @@ +import Test.Hspec +import SimpleCmd + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "cmds" $ do + it "cmd" $ do + out <- cmd "echo" ["hello"] + out `shouldBe` "hello" + + it "cmdBool true" $ do + ok <- cmdBool "true" [] + ok `shouldBe` True + + it "cmdBool false" $ do + ok <- cmdBool "false" [] + ok `shouldBe` False + + it "cmdLines" $ do + out <- cmdLines "echo" ["1\n2"] + out `shouldBe` ["1","2"] + + describe "pipes" $ do + it "pipe" $ do + out <- pipe ("echo", ["hello"]) ("grep",["hello"]) + out `shouldBe` "hello"