diff options
| -rw-r--r-- | Command/Uninit.hs | 2 | ||||
| -rw-r--r-- | Command/Unused.hs | 2 | ||||
| -rw-r--r-- | Git/Branch.hs | 8 | ||||
| -rw-r--r-- | Git/Command.hs | 32 | ||||
| -rw-r--r-- | Git/Ref.hs | 4 | ||||
| -rw-r--r-- | Utility/Process.hs | 6 |
6 files changed, 36 insertions, 18 deletions
diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 46a2480e6..6ac3e1216 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -32,7 +32,7 @@ check = do error "can only run uninit from the top of the git repository" where current_branch = Git.Ref . Prelude.head . lines <$> revhead - revhead = inRepo $ Git.Command.pipeRead + revhead = inRepo $ Git.Command.pipeReadStrict [Params "rev-parse --abbrev-ref HEAD"] seek :: [CommandSeek] diff --git a/Command/Unused.hs b/Command/Unused.hs index 91b21afa5..6fb8f36c6 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -251,7 +251,7 @@ withKeysReferencedInGit a = do rs <- relevantrefs <$> showref forM_ rs (withKeysReferencedInGitRef a) where - showref = inRepo $ Git.Command.pipeRead [Param "show-ref"] + showref = inRepo $ Git.Command.pipeReadStrict [Param "show-ref"] relevantrefs = map (Git.Ref . snd) . nubBy uniqref . filter ourbranches . diff --git a/Git/Branch.hs b/Git/Branch.hs index f73ae5e2a..3407845d1 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -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 diff --git a/Git/Command.hs b/Git/Command.hs index 687f6802c..71579808b 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -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" diff --git a/Git/Ref.hs b/Git/Ref.hs index cfaafacef..6fec46c22 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -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) diff --git a/Utility/Process.hs b/Utility/Process.hs index 839cc4078..b47807921 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -116,8 +116,10 @@ checkSuccessProcess pid = do code <- waitForProcess pid return $ code == ExitSuccess -ignoreFailureProcess :: ProcessHandle -> IO () -ignoreFailureProcess = void . waitForProcess +ignoreFailureProcess :: ProcessHandle -> IO Bool +ignoreFailureProcess pid = do + void $ waitForProcess pid + return True {- Runs createProcess, then an action on its handles, and then - forceSuccessProcess. -} |