make a pipeReadStrict, that properly waits on the process

Nearly everything that's reading from git is operating on a small
amount of output and has been switched to use that. Only pipeNullSplit
stuff continues using the lazy version that yields zombies.
This commit is contained in:
Joey Hess 2012-10-04 18:04:09 -04:00
parent 046f51c93b
commit f67b54e5e3
6 changed files with 36 additions and 18 deletions

View file

@ -27,7 +27,7 @@ current r = do
case v of
Nothing -> return Nothing
Just branch ->
ifM (null <$> pipeRead [Param "show-ref", Param $ show branch] r)
ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r)
( return Nothing
, return v
)
@ -35,7 +35,7 @@ current r = do
{- The current branch, which may not really exist yet. -}
currentUnsafe :: Repo -> IO (Maybe Git.Ref)
currentUnsafe r = parse . firstLine
<$> pipeRead [Param "symbolic-ref", Param "HEAD"] r
<$> pipeReadStrict [Param "symbolic-ref", Param "HEAD"] r
where
parse l
| null l = Nothing
@ -48,7 +48,7 @@ changed origbranch newbranch repo
| origbranch == newbranch = return False
| otherwise = not . null <$> diffs
where
diffs = pipeRead
diffs = pipeReadStrict
[ Param "log"
, Param (show origbranch ++ ".." ++ show newbranch)
, Params "--oneline -n1"
@ -93,7 +93,7 @@ fastForward branch (first:rest) repo =
commit :: String -> Branch -> [Ref] -> Repo -> IO Sha
commit message branch parentrefs repo = do
tree <- getSha "write-tree" $
pipeRead [Param "write-tree"] repo
pipeReadStrict [Param "write-tree"] repo
sha <- getSha "commit-tree" $ pipeWriteRead
(map Param $ ["commit-tree", show tree] ++ ps)
message repo

View file

@ -43,14 +43,27 @@ run subcommand params repo = assertLocal repo $
- Note that this leaves the git process running, and so zombies will
- result unless reap is called.
-}
pipeRead :: [CommandParam] -> Repo -> IO String
pipeRead params repo = assertLocal repo $
pipeReadLazy :: [CommandParam] -> Repo -> IO String
pipeReadLazy params repo = assertLocal repo $
withHandle StdoutHandle createBackgroundProcess p $ \h -> do
fileEncoding h
hGetContents h
where
p = (proc "git" $ toCommand $ gitCommandLine params repo)
{ env = gitEnv repo }
p = gitCreateProcess params repo
{- Runs a git subcommand, and returns its output, strictly.
-
- Nonzero exit status is ignored.
-}
pipeReadStrict :: [CommandParam] -> Repo -> IO String
pipeReadStrict params repo = assertLocal repo $
withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
fileEncoding h
output <- hGetContentsStrict h
hClose h
return output
where
p = gitCreateProcess params repo
{- Runs a git subcommand, feeding it input, and returning its output,
- which is expected to be fairly small, since it's all read into memory
@ -62,16 +75,19 @@ pipeWriteRead params s repo = assertLocal repo $
{- Runs a git subcommand, feeding it input on a handle with an action. -}
pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
pipeWrite params repo = withHandle StdinHandle createProcessSuccess p
where
p = (proc "git" $ toCommand $ gitCommandLine params repo)
pipeWrite params repo = withHandle StdinHandle createProcessSuccess $
gitCreateProcess params repo
gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess
gitCreateProcess params repo =
(proc "git" $ toCommand $ gitCommandLine params repo)
{ env = gitEnv repo }
{- Reads null terminated output of a git command (as enabled by the -z
- parameter), and splits it. -}
pipeNullSplit :: [CommandParam] -> Repo -> IO [String]
pipeNullSplit params repo =
filter (not . null) . split sep <$> pipeRead params repo
filter (not . null) . split sep <$> pipeReadLazy params repo
where
sep = "\0"

View file

@ -41,7 +41,7 @@ exists ref = runBool "show-ref"
sha :: Branch -> Repo -> IO (Maybe Sha)
sha branch repo = process <$> showref repo
where
showref = pipeRead [Param "show-ref",
showref = pipeReadStrict [Param "show-ref",
Param "--hash", -- get the hash
Param $ show branch]
process [] = Nothing
@ -50,7 +50,7 @@ sha branch repo = process <$> showref repo
{- List of (refs, branches) matching a given ref spec. -}
matching :: Ref -> Repo -> IO [(Ref, Branch)]
matching ref repo = map gen . lines <$>
pipeRead [Param "show-ref", Param $ show ref] repo
pipeReadStrict [Param "show-ref", Param $ show ref] repo
where
gen l = let (r, b) = separate (== ' ') l in
(Ref r, Ref b)