shh 0.7.0.2 → 0.7.0.3

raw patch · 6 files changed

+32/−11 lines, 6 files

Files

• ChangeLog.md +4/−0
• README.md +1/−1
• shh.cabal +1/−1
• src/Shh/Internal.hs +24/−7
• test/Readme.lhs +1/−1
• test/Test.hs +1/−1

@@ -1,5 +1,9 @@ # Revision history for shh +## 0.7.0.3 -- 2019-08-21++Allow optionally capturing stdout on failure exceptions+ ## 0.7.0.1 -- 2019-08-12  Change how we test for library installation.

@@ -307,7 +307,7 @@  | Library | Exception on non-zero | Contains arguments | Contains `stderr` | Terminates pipeline | |---------|-----------------------|--------------------|-------------------|---------------------|-| Shh     | Yes                   | Yes                | No                | Yes                 |+| Shh     | Yes                   | Yes                | Optional          | Yes                 | | Shelly  | Yes                   | Yes                | Yes               | Yes                 | | Turtle  | Sometimes             | No                 | No                | ?                   | | shell-conduit | Yes             | Yes                | No                | No                  |

@@ -1,5 +1,5 @@ name:                shh-version:             0.7.0.2+version:             0.7.0.3 synopsis:            Simple shell scripting from Haskell description:         Provides a shell scripting environment for Haskell. It                      helps you use external binaries, and allows you to

@@ -88,10 +88,12 @@ -- The only exception to this is when a process is terminated -- by @SIGPIPE@ in a pipeline, in which case we ignore it. data Failure = Failure-    { failureProg  :: ByteString-    , failureArgs  :: [ByteString]-    , failureStack :: CallStack-    , failureCode  :: Int+    { failureProg   :: ByteString+    , failureArgs   :: [ByteString]+    , failureStack  :: CallStack+    , failureCode   :: Int+    -- | Failure can optionally contain the stderr of a process.+    , failureStdErr :: Maybe ByteString     }  instance Show Failure where@@ -105,6 +107,8 @@         , "] at "         , prettyCallStack (failureStack f)         ]+        ++ flip (maybe []) (failureStdErr f) (\s ->+           ["\n-- stderr --\n" ++ BC8.unpack s])  instance Exception Failure @@ -509,7 +513,7 @@ waitProc cmd arg ph = waitForProcess ph >>= \case     ExitFailure c         | fromIntegral c == negate sigPIPE -> pure ()-        | otherwise -> throwIO $ Failure cmd arg callStack c+        | otherwise -> throwIO $ Failure cmd arg callStack c Nothing     ExitSuccess -> pure ()  @@ -533,9 +537,22 @@ -- | Run a `Proc` action, catching any `Failure` exceptions -- and returning them. tryFailure :: Shell m => Proc a -> m (Either Failure a)-tryFailure (Proc f) = buildProc $ \i o e -> do-    (try $ f i o e)+tryFailure (Proc f) = buildProc $ \i o e -> try $ f i o e +-- | Capture the stderr of the proc, and attach it to any @`Failure`@+-- exceptions that are thrown. The stderr is also forwarded to downstream+-- processes, or the inherited stderr handle. Note that capturing stderr+-- inherently requires that the stderr is accumulated in memory, so be+-- careful about processes that dump a lot of information.+failWithStdErr :: Shell io => Proc a -> io a+failWithStdErr p = runProc $ do+    r <- tryFailure p `pipeErr` readInputP (\i -> do+        writeError i+        pure i+        )+    case r of+        (Right a, _) -> pure a+        (Left f, err) -> liftIO $ throwIO $ f {failureStdErr = Just err}  -- | Run a `Proc` action, ignoring any `Failure` exceptions. -- This can be used to prevent a process from interrupting a whole pipeline.

@@ -307,7 +307,7 @@  | Library | Exception on non-zero | Contains arguments | Contains `stderr` | Terminates pipeline | |---------|-----------------------|--------------------|-------------------|---------------------|-| Shh     | Yes                   | Yes                | No                | Yes                 |+| Shh     | Yes                   | Yes                | Optional          | Yes                 | | Shelly  | Yes                   | Yes                | Yes               | Yes                 | | Turtle  | Sometimes             | No                 | No                | ?                   | | shell-conduit | Yes             | Yes                | No                | No                  |

@@ -39,7 +39,7 @@     defaultMain tests  tests :: TestTree-tests = localOption (Timeout 4000000 "4s") $ testGroup "Tests" [unitTests, properties]+tests = localOption (Timeout 8000000 "8s") $ testGroup "Tests" [unitTests, properties]  bytesToString :: [Word8] -> ByteString bytesToString = BS.pack