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

convert to withCreateProcess

Browse source 
Makes it stop the command if the consumer gets killed.

Also, it seems that the old version expected bracketOnError to return
the False from the error handler, but it does not, it would have thrown
the exception and ignored the False. That's fixed, it will now return
False when there is an exception.
This commit is contained in:
Joey Hess 2020-06-03 13:15:01 -04:00
parent 53263efe4b
commit 94986fb228
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 12 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
Utility/MagicWormhole.hs
View file

@ -30,12 +30,12 @@ import Utility.Monad
import Utility.Misc
import Utility.Env
import Utility.Path
import Utility.Exception
import System.IO
import System.Exit
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
import Data.Char
import Data.List
import Control.Applicative
@ -146,26 +146,22 @@ wormHoleProcess :: WormHoleParams -> CreateProcess
wormHoleProcess = proc "wormhole" . toCommand
runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> Handle -> IO Bool) -> IO Bool
runWormHoleProcess p consumer =
bracketOnError setup (\v -> cleanup v <&&> return False) go
runWormHoleProcess p consumer =
withCreateProcess p' go `catchNonAsync` const (return False)
where
setup = do
(Just hin, Just hout, Just herr, pid)
<- createProcess p
{ std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
}
return (hin, hout, herr, pid)
cleanup (hin, hout, herr, pid) = do
p' = p
{ std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
}
go (Just hin) (Just hout) (Just herr) pid =
consumer hin hout herr <&&> waitbool pid
go _ _ _ _ = error "internal"
waitbool pid = do
r <- waitForProcess pid
hClose hin
hClose hout
hClose herr
return $ case r of
ExitSuccess -> True
ExitFailure _ -> False
go h@(hin, hout, herr, _) = consumer hin hout herr <&&> cleanup h
isInstalled :: IO Bool
isInstalled = inPath "wormhole"