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