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

convert to withCreateProcess for async exception safety

Browse source 
This handles all createProcessSuccess callers, and aside from process
pools, the complete conversion of all process running to async exception
safety should be complete now.

Also, was able to remove from Utility.Process the old API that I now
know was not a good idea. And proof it was bad: The code size went *down*,
despite there being a fair bit of boilerplate for some future API to
reduce.
This commit is contained in:
Joey Hess 2020-06-04 15:36:34 -04:00
parent 12e7d52c8b
commit 2670890b17
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
16 changed files with 196 additions and 191 deletions
Download patch file Download diff file Expand all files Collapse all files

40
Git/Config.hs
View file

@ -58,29 +58,37 @@ read' repo = go repo
go Repo { location = Local { gitdir = d } } = git_config d
go Repo { location = LocalUnknown d } = git_config d
go _ = assertLocal repo $ error "internal"
git_config d = withHandle StdoutHandle createProcessSuccess p $
hRead repo ConfigNullList
git_config d = withCreateProcess p (git_config' p)
where
params = ["config", "--null", "--list"]
p = (proc "git" params)
{ cwd = Just (fromRawFilePath d)
, env = gitEnv repo
, std_out = CreatePipe
}
git_config' p _ (Just hout) _ pid =
forceSuccessProcess p pid
`after`
hRead repo ConfigNullList hout
git_config' _ _ _ _ _ = error "internal"
{- Gets the global git config, returning a dummy Repo containing it. -}
global :: IO (Maybe Repo)
global = do
home <- myHomeDir
ifM (doesFileExist $ home </> ".gitconfig")
( do
repo <- withHandle StdoutHandle createProcessSuccess p $
hRead (Git.Construct.fromUnknown) ConfigNullList
return $ Just repo
( Just <$> withCreateProcess p go
, return Nothing
)
where
params = ["config", "--null", "--list", "--global"]
p = (proc "git" params)
{ std_out = CreatePipe }
go _ (Just hout) _ pid =
forceSuccessProcess p pid
`after`
hRead (Git.Construct.fromUnknown) ConfigNullList hout
go _ _ _ _ = error "internal"
{- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> ConfigStyle -> Handle -> IO Repo
@ -200,16 +208,20 @@ coreBare = "core.bare"
- and returns a repo populated with the configuration, as well as the raw
- output and any standard output of the command. -}
fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
fromPipe r cmd params st = try $
withOEHandles createProcessSuccess p $ \(hout, herr) -> do
geterr <- async $ S.hGetContents herr
getval <- async $ S.hGetContents hout
val <- wait getval
err <- wait geterr
fromPipe r cmd params st = try $ withCreateProcess p go
where
p = (proc cmd $ toCommand params)
{ std_out = CreatePipe
, std_err = CreatePipe
}
go _ (Just hout) (Just herr) pid = do
(val, err) <- concurrently
(S.hGetContents hout)
(S.hGetContents herr)
forceSuccessProcess p pid
r' <- store val st r
return (r', val, err)
where
p = proc cmd $ toCommand params
go _ _ _ _ = error "internal"
{- Reads git config from a specified file and returns the repo populated
- with the configuration. -}