simple-cmd 0.2.3 → 0.2.4
raw patch · 7 files changed
+168/−47 lines, 7 filesdep +hspecdep +simple-cmddep ~basedep ~directorysetup-changed
Dependencies added: hspec, simple-cmd
Dependency ranges changed: base, directory
Files
- ChangeLog.md +6/−0
- README.md +1/−1
- Setup.hs +0/−2
- SimpleCmd.hs +83/−38
- TODO +3/−0
- simple-cmd.cabal +46/−6
- test/Spec.hs +29/−0
ChangeLog.md view
@@ -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
README.md view
@@ -1,4 +1,3 @@-[](https://travis-ci.com/juhp/simple-cmd) [](http://hackage.haskell.org/package/simple-cmd) [](http://stackage.org/lts/package/simple-cmd) [](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
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
SimpleCmd.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Some simple String wrappers of `readProcess`, `readProcessWithExitCode`, `rawSystem` from the Haskell <https://hackage.haskell.org/package/process process> 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
TODO view
@@ -1,3 +1,6 @@ - source headers - examples++# 0.3+ - add cmdLog_ (api break)+- use Proc for pipes
simple-cmd.cabal view
@@ -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 <juhpetersen@gmail.com>+author: Jens Petersen <juhpetersen@gmail.com>+maintainer: Jens Petersen <juhpetersen@gmail.com>+copyright: 2017-2022 Jens Petersen <juhpetersen@gmail.com> 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
+ test/Spec.hs view
@@ -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"