shh 0.2.0.6 → 0.3.0.0
raw patch · 5 files changed
+59/−52 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +8/−14
- app/Example.hs +2/−2
- shh.cabal +1/−7
- src/Shh/Internal.hs +17/−13
- test/Test.hs +31/−16
ChangeLog.md view
@@ -1,22 +1,16 @@-# Revision history for execpath--## 0.2.0.0 -- 2019-01-23--* Extended the ExecArg typeclass to handle lists.+# Revision history for shh -## 0.1.1.0 -- 2019-01-22+## 0.3.X.X -- 2019-03-10 -* Generate an IO action to check for missing dependencies at runtime.+* Changes how lazy reading works. We no longer terminate the process, we+ just close the handles and wait for the process to terminate naturally. -* Add ability to use TH to load a list of specific executables.+ This eliminates a source of non-determinism -## 0.1.0.1 -- 2019-01-22+## 0.2.X.X -- 2019-01-23 -* Force output of lazy read functions to normal form to prevent- people from accidentally holding onto resources.+* Extended the ExecArg typeclass to handle lists. -* New helper functions for reading.- -## 0.1.0.0 -- 2018-11-02+## 0.1.X.X -- 2018-11-02 * First version. Released on an unsuspecting world.
app/Example.hs view
@@ -16,7 +16,7 @@ -- OR -- -- We could also be a little more explicit about it.-$(load Absolute ["sleep", "echo", "cat", "xxd"])+$(load Absolute ["sleep", "echo", "cat", "tr"]) main :: IO () main = do@@ -24,4 +24,4 @@ [] <- missingExecutables concurrently_ ((sleep 1 >> echo "Hello" >> sleep 2) |> cat)- (echo "A" >> sleep 1 >> echo "b" |> xxd)+ (echo "A" >> sleep 1 >> echo "bc" |> tr "-d" "c")
shh.cabal view
@@ -1,5 +1,5 @@ name: shh-version: 0.2.0.6+version: 0.3.0.0 synopsis: Simple shell scripting from Haskell description: Provides a shell scripting environment for Haskell. It helps you all external binaries, and allows you to@@ -63,9 +63,6 @@ shh hs-source-dirs: app main-is: Example.hs- build-tools:- coreutils,- vim test-suite shh-tests@@ -77,9 +74,6 @@ tasty-quickcheck, tasty-hunit, shh- build-tools:- perl,- vim hs-source-dirs: test main-is: Test.hs type: exitcode-stdio-1.0
src/Shh/Internal.hs view
@@ -13,7 +13,6 @@ -- | See documentation for "Shh". module Shh.Internal where - import Control.Concurrent.Async import Control.DeepSeq (force,NFData) import Control.Exception as C@@ -106,7 +105,10 @@ writeProc :: Proc a -> String -> f a -- | Run a process and capture it's output lazily. Once the continuation- -- is completed, the handles are closed, and the process is terminated.+ -- is completed, the handles are closed. However, the process is run+ -- until it naturally terminates in order to capture the correct exit+ -- code. Many utilities behave correctly with this (e.g. @cat@ will+ -- terminate if you close the handle). withRead :: (NFData b) => Proc a -> (String -> IO b) -> f b instance PipeResult IO where@@ -128,18 +130,18 @@ instance PipeResult Proc where (Proc a) |> (Proc b) = Proc $ \i o e pl pw -> withPipe $ \r w -> do- a' <- async $ a i w e (pure ()) (hClose w)- b' <- async $ b r o e (pure ()) (hClose r)- link2 a' b'- (_, br) <- (pl >> waitBoth a' b') `finally` pw+ let+ a' = a i w e (pure ()) (hClose w)+ b' = b r o e (pure ()) (hClose r)+ (_, br) <- (pl >> concurrently a' b') `finally` pw pure br (Proc a) |!> (Proc b) = Proc $ \i o e pl pw -> do withPipe $ \r w -> do- a' <- async $ a i o w (pure ()) (hClose w)- b' <- async $ b r o e (pure ()) (hClose r)- link2 a' b'- (_, br) <- (pl >> waitBoth a' b') `finally` pw+ let+ a' = a i o w (pure ()) (hClose w)+ b' = b r o e (pure ()) (hClose r)+ (_, br) <- (pl >> concurrently a' b') `finally` pw pure br p &> StdOut = p@@ -164,8 +166,10 @@ withRead (Proc f) k = Proc $ \i _ e pl pw -> do withPipe $ \r w -> do- withAsync (f i w e pl (hClose w `finally` pw)) $ \_ ->- (hGetContents r >>= k >>= C.evaluate . force) `finally` hClose r+ withAsync (f i w e pl (hClose w `finally` pw)) $ \a -> do+ rr <- (hGetContents r >>= k >>= C.evaluate . force) `finally` hClose r+ _ <- wait a+ pure rr -- | Type used to represent destinations for redirects. @`Truncate` file@ -- is like @> file@ in a shell, and @`Append` file@ is like @>> file@.@@ -289,7 +293,7 @@ (<<<) :: PipeResult io => Proc a -> String -> io a (<<<) = writeProc --- | What on a given `ProcessHandle`, and throw an exception of+-- | Wait on a given `ProcessHandle`, and throw an exception of -- type `Failure` if it's exit code is non-zero (ignoring SIGPIPE) waitProc :: String -> [String] -> ProcessHandle -> IO () waitProc cmd arg ph = waitForProcess ph >>= \case
test/Test.hs view
@@ -6,8 +6,10 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck+import Control.Exception+import Control.Monad -$(load SearchPath ["shasum", "xxd", "echo", "cat", "false", "mktemp", "sleep", "rm"])+$(load SearchPath ["tr", "echo", "cat", "true", "false", "mktemp", "sleep", "rm"]) main = do putStrLn "################################################"@@ -26,6 +28,9 @@ [ testProperty "trim = trim . trim" $ \l -> trim l == trim (trim l) ] +withTmp :: (FilePath -> IO a) -> IO a+withTmp = bracket (readTrim mktemp) rm+ unitTests :: TestTree unitTests = testGroup "Unit tests" [ testCase "Read stdout" $ do@@ -34,36 +39,31 @@ , testCase "Redirect to /dev/null" $ do l <- readProc $ echo "test" &> devNull l @?= ""- , testCase "Redirect to file (Truncate)" $ do- t <- trim <$> readProc mktemp+ , testCase "Redirect to file (Truncate)" $ withTmp $ \t -> do echo "test" &> Truncate t r <- readProc $ cat t- rm t "test\n" @?= r- , testCase "Redirect to file (Append)" $ do- t <- readTrim mktemp+ , testCase "Redirect to file (Append)" $ withTmp $ \t -> do echo "test" &> Truncate t echo "test" &> Append t r <- readProc $ cat t- rm t "test\ntest\n" @?= r , testCase "Long pipe" $ do- r <- readProc $ echo "test" |> shasum |> shasum |> shasum- r @?= "3f18e7bc4021e72e52fc1395ece85d82f912a74a -\n"+ r <- readProc $ echo "test" |> tr "-d" "e" |> tr "-d" "s"+ r @?= "tt\n" , testCase "Pipe stderr" $ do r <- readProc $ echo "test" &> StdErr |!> cat r @?= "test\n" , testCase "Lazy read" $ do- withRead (cat "/dev/urandom" |> xxd) $ \s -> do- take 6 s @?= "000000"+ withRead (cat "/dev/urandom" |> tr "-C" "-d" "a") $ \s -> do+ take 6 s @?= "aaaaaa" , testCase "Multiple outputs" $ do l <- readProc $ (echo (1 :: Int) >> echo (2 :: Int)) |> cat l @?= "1\n2\n" , testCase "Terminate upstream processes" $ do Left x <- catchFailure (mkProc "false" ["dummy"] |> (sleep 1 >> false "Didn't kill")) x @?= Shh.Failure "false" ["dummy"] 1- , testCase "Write to process" $ do- t <- readTrim mktemp+ , testCase "Write to process" $ withTmp $ \t -> do writeProc (cat &> Truncate t) "Hello" r <- readProc (cat t) r @?= "Hello"@@ -71,9 +71,24 @@ r <- readProc (cat t) r @?= "Goodbye" , testCase "apply" $ do- r <- apply shasum "test"- r @?= "a94a8fe5ccb19ba61c4c0873d391e987982fbbd3 -\n"- , testCase "ignoreFailure" $ do+ r <- apply (tr "-d" "es") "test"+ r @?= "tt"+ , testCase "ignoreFailure" $ replicateM_ 30 $ do r <- readProc $ ignoreFailure false |> echo "Hello" r @?= "Hello\n"+ , testCase "Read failure" $ replicateM_ 30 $ do+ Left r <- catchFailure $ readProc $ false "dummy"+ r @?= Shh.Failure "false" ["dummy"] 1+ , testCase "Read failure chain start" $ replicateM_ 30 $ do+ Left r <- catchFailure $ readProc $ false "dummy" |> echo "test" |> true+ r @?= Shh.Failure "false" ["dummy"] 1+ , testCase "Read failure chain middle" $ replicateM_ 30 $ do+ Left r <- catchFailure $ readProc $ echo "test" |> false "dummy" |> true+ r @?= Shh.Failure "false" ["dummy"] 1+ , testCase "Read failure chain end" $ replicateM_ 30 $ do+ Left r <- catchFailure $ readProc $ echo "test" |> true |> false "dummy"+ r @?= Shh.Failure "false" ["dummy"] 1+ , testCase "Lazy read checks code" $ replicateM_ 30 $ do+ Left r <- catchFailure $ withRead (cat "/dev/urandom" |> false "dummy") $ pure . take 3+ r @?= Shh.Failure "false" ["dummy"] 1 ]