mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

convert processTranscript to use hGetLineUntilExitOrEOF

Browse source 
It does use it on both stdout and stderr. It seems unlikely the problem
could really affect stdout, but the unix implementation of it combines
both into a single handle in any case.
This commit is contained in:
Joey Hess 2020-11-19 16:36:37 -04:00
parent ff0927bde9
commit b13c44cccc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 9 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
Utility/Process/Transcript.hs
View file

@ -15,7 +15,6 @@ module Utility.Process.Transcript (
) where
import Utility.Process
import Utility.Misc
import System.IO
import System.Exit
@ -63,10 +62,10 @@ processTranscript'' cp input = do
, std_err = UseHandle writeh
}
withCreateProcess cp' $ \hin hout herr pid -> do
get <- asyncreader readh
get <- asyncreader pid readh
writeinput input (hin, hout, herr, pid)
transcript <- wait get
code <- waitForProcess pid
transcript <- wait get
return (transcript, code)
#else
{- This implementation for Windows puts stderr after stdout. -}
@ -77,16 +76,18 @@ processTranscript'' cp input = do
}
withCreateProcess cp' $ \hin hout herr pid -> do
let p = (hin, hout, herr, pid)
getout <- asyncreader (stdoutHandle p)
geterr <- asyncreader (stderrHandle p)
getout <- asyncreader pid (stdoutHandle p)
geterr <- asyncreader pid (stderrHandle p)
writeinput input p
transcript <- (++) <$> wait getout <*> wait geterr
code <- waitForProcess pid
transcript <- (++) <$> wait getout <*> wait geterr
return (transcript, code)
#endif
where
asyncreader = async . hGetContentsStrict
asyncreader pid h = async $ reader pid h []
reader pid h c = hGetLineUntilExitOrEOF pid h >>= \case
Nothing -> return (concat (reverse c))
Just l -> reader pid h (l:c)
writeinput (Just s) p = do
let inh = stdinHandle p
unless (null s) $ do