typed-process 0.2.3.0 → 0.2.4.0
raw patch · 4 files changed
+112/−9 lines, 4 files
Files
- ChangeLog.md +5/−0
- src/System/Process/Typed.hs +72/−4
- test/System/Process/TypedSpec.hs +30/−0
- typed-process.cabal +5/−5
ChangeLog.md view
@@ -1,3 +1,8 @@+## 0.2.4.0++* Add `readProcessInterleaved` and `readProcessInterleaved_` to support+ capturing output from stdout and stderr in a single ByteString value.+ ## 0.2.3.0 * Add support for the single-threaded runtime via polling
src/System/Process/Typed.hs view
@@ -65,6 +65,8 @@ , readProcessStdout_ , readProcessStderr , readProcessStderr_+ , readProcessInterleaved+ , readProcessInterleaved_ -- * Interact with a process @@ -534,7 +536,18 @@ -- -- @since 0.1.0.0 byteStringOutput :: StreamSpec 'STOutput (STM L.ByteString)-byteStringOutput = mkStreamSpec P.CreatePipe $ \pc (Just h) -> do+byteStringOutput = mkStreamSpec P.CreatePipe $ \pc (Just h) -> byteStringFromHandle pc h++-- | Helper function (not exposed) for both 'byteStringOutput' and+-- 'withProcessInterleave'. This will consume all of the output from+-- the given 'Handle' in a separate thread and provide access to the+-- resulting 'L.ByteString' via STM. Second action will close the+-- reader handle.+byteStringFromHandle+ :: ProcessConfig () () ()+ -> Handle -- ^ reader handle+ -> IO (STM L.ByteString, IO ())+byteStringFromHandle pc h = do mvar <- newEmptyTMVarIO void $ async $ do@@ -799,12 +812,13 @@ where pc' = setStdout byteStringOutput pc --- | Same as 'readProcess', but only read the stderr of the process. Original settings for stderr remain.+-- | Same as 'readProcess', but only read the stderr of the process.+-- Original settings for stdout remain. -- -- @since 0.2.1.0 readProcessStderr :: MonadIO m- => ProcessConfig stdin stderrIgnored stderr+ => ProcessConfig stdin stdout stderrIgnored -> m (ExitCode, L.ByteString) readProcessStderr pc = liftIO $ withProcess pc' $ \p -> atomically $ (,)@@ -819,7 +833,7 @@ -- @since 0.2.1.0 readProcessStderr_ :: MonadIO m- => ProcessConfig stdin stderrIgnored stderr+ => ProcessConfig stdin stdout stderrIgnored -> m L.ByteString readProcessStderr_ pc = liftIO $ withProcess pc' $ \p -> atomically $ do@@ -830,6 +844,60 @@ return stderr where pc' = setStderr byteStringOutput pc++withProcessInterleave+ :: ProcessConfig stdin stdoutIgnored stderrIgnored+ -> (Process stdin (STM L.ByteString) () -> IO a)+ -> IO a+withProcessInterleave pc inner = do+ -- Create a pipe to be shared for both stdout and stderr+ (readEnd, writeEnd) <- P.createPipe++ -- Use the writer end of the pipe for both stdout and stderr. For+ -- the stdout half, use byteStringFromHandle to read the data into+ -- a lazy ByteString in memory.+ let pc' = setStdout (mkStreamSpec (P.UseHandle writeEnd) (\pc'' Nothing -> byteStringFromHandle pc'' readEnd))+ $ setStderr (useHandleOpen writeEnd)+ pc+ withProcess pc' $ \p -> do+ -- Now that the process is forked, close the writer end of this+ -- pipe, otherwise the reader end will never give an EOF.+ hClose writeEnd+ inner p++-- | Same as 'readProcess', but interleaves stderr with stdout.+--+-- Motivation: Use this function if you need stdout interleaved with stderr+-- output (e.g. from an HTTP server) in order to debug failures.+--+-- @since 0.2.4.0+readProcessInterleaved+ :: MonadIO m+ => ProcessConfig stdin stdoutIgnored stderrIgnored+ -> m (ExitCode, L.ByteString)+readProcessInterleaved pc =+ liftIO $+ withProcessInterleave pc $ \p ->+ atomically $ (,)+ <$> waitExitCodeSTM p+ <*> getStdout p++-- | Same as 'readProcessInterleaved', but instead of returning the 'ExitCode',+-- checks it with 'checkExitCode'.+--+-- @since 0.2.4.0+readProcessInterleaved_+ :: MonadIO m+ => ProcessConfig stdin stdoutIgnored stderrIgnored+ -> m L.ByteString+readProcessInterleaved_ pc =+ liftIO $ do+ withProcessInterleave pc $ \p -> atomically $ do+ stdout' <- getStdout p+ checkExitCodeSTM p `catchSTM` \ece -> throwSTM ece+ { eceStdout = stdout'+ }+ return stdout' -- | Run the given process, wait for it to exit, and returns its -- 'ExitCode'.
test/System/Process/TypedSpec.hs view
@@ -86,3 +86,33 @@ let encoded = S.filter (/= 10) $ L.toStrict lbs raw <- S.readFile fp encoded `shouldBe` B64.encode raw++ it "interleaved output" $ withSystemTempFile "interleaved-output" $ \fp h -> do+ S.hPut h "\necho 'stdout'\n>&2 echo 'stderr'\necho 'stdout'"+ hClose h++ let config = proc "sh" [fp]+ -- Assert, that our bash script doesn't send output only to stdout and+ -- we assume that we captured from stderr as well+ onlyErr <- readProcessStderr_ (setStdout createPipe config)+ onlyErr `shouldBe` "stderr\n"++ (res, lbs1) <- readProcessInterleaved config+ res `shouldBe` ExitSuccess+ lbs1 `shouldBe` "stdout\nstderr\nstdout\n"++ lbs2 <- readProcessInterleaved_ config+ lbs1 `shouldBe` lbs2++ it "interleaved output handles large data" $ withSystemTempFile "interleaved-output" $ \fp h -> do+ S.hPut h "\nfor i in {1..4064}; do\necho 'stdout';\n>&2 echo 'stderr';\necho 'stdout';\ndone"+ hClose h++ let config = proc "sh" [fp]+ (result, lbs1) <- readProcessInterleaved config+ result `shouldBe` ExitSuccess+ lbs2 <- readProcessInterleaved_ config+ lbs1 `shouldBe` lbs2++ let expected = "stdout\nstderr\nstdout\n"+ L.take (L.length expected) lbs1 `shouldBe` expected
typed-process.cabal view
@@ -1,13 +1,13 @@-cabal-version: >= 1.10+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.0.+-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 8fd30ba42322fffadc01326bcc1370fa86c650057800ca91d5381d89e91df797+-- hash: 11c70077cb1b56f53730fd5ab768dd6b89dd6c3850649afb4cae269796982aff name: typed-process-version: 0.2.3.0+version: 0.2.4.0 synopsis: Run external processes, with strong typing of streams description: Please see the tutorial at <https://haskell-lang.org/library/typed-process> category: System@@ -19,8 +19,8 @@ license-file: LICENSE build-type: Simple extra-source-files:- ChangeLog.md README.md+ ChangeLog.md source-repository head type: git