diff options
Diffstat (limited to 'Git')
-rw-r--r-- | Git/Command.hs | 13 | ||||
-rw-r--r-- | Git/Config.hs | 15 | ||||
-rw-r--r-- | Git/Queue.hs | 13 | ||||
-rw-r--r-- | Git/UpdateIndex.hs | 13 |
4 files changed, 22 insertions, 32 deletions
diff --git a/Git/Command.hs b/Git/Command.hs index 038824f26..d7c983064 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -7,7 +7,6 @@ module Git.Command where -import System.Process import System.Posix.Process (getAnyProcessStatus) import Common @@ -41,12 +40,12 @@ run subcommand params repo = assertLocal repo $ - result unless reap is called. -} pipeRead :: [CommandParam] -> Repo -> IO String -pipeRead params repo = assertLocal repo $ do - (_, Just h, _, _) <- createProcess - (proc "git" $ toCommand $ gitCommandLine params repo) - { std_out = CreatePipe } - fileEncoding h - hGetContents h +pipeRead params repo = assertLocal repo $ + withHandle StdoutHandle createBackgroundProcess p $ \h -> do + fileEncoding h + hGetContents h + where + p = proc "git" $ toCommand $ gitCommandLine 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 diff --git a/Git/Config.hs b/Git/Config.hs index 234750113..c82d6bb1b 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -9,7 +9,7 @@ module Git.Config where import qualified Data.Map as M import Data.Char -import System.Process +import System.Process (cwd) import Common import Git @@ -48,14 +48,11 @@ 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 = do - (_, Just h, _, pid) - <- createProcess (proc "git" params) - { std_out = CreatePipe, cwd = Just d } - repo' <- hRead repo h - forceSuccessProcess pid "git" params - return repo' - params = ["config", "--null", "--list"] + git_config d = withHandle StdoutHandle createProcessSuccess p $ + hRead repo + where + params = ["config", "--null", "--list"] + p = (proc "git" params) { cwd = Just d } {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo diff --git a/Git/Queue.hs b/Git/Queue.hs index 4e6f05c2e..f515ad104 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -19,7 +19,6 @@ module Git.Queue ( import qualified Data.Map as M import System.IO -import System.Process import Data.String.Utils import Utility.SafeCommand @@ -148,13 +147,11 @@ runAction :: Repo -> Action -> IO () runAction repo (UpdateIndexAction streamers) = -- list is stored in reverse order Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers -runAction repo action@(CommandAction {}) = do - (Just h, _, _, pid) <- createProcess (proc "xargs" params) - { std_in = CreatePipe } - fileEncoding h - hPutStr h $ join "\0" $ getFiles action - hClose h - forceSuccessProcess pid "xargs" params +runAction repo action@(CommandAction {}) = + withHandle StdinHandle createProcessSuccess (proc "xargs" params) $ \h -> do + fileEncoding h + hPutStr h $ join "\0" $ getFiles action + hClose h where params = "-0":"git":baseparams baseparams = toCommand $ gitCommandLine diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 6de0c3ada..929448729 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -17,8 +17,6 @@ module Git.UpdateIndex ( stageSymlink ) where -import System.Process - import Common import Git import Git.Types @@ -36,12 +34,11 @@ pureStreamer !s = \streamer -> streamer s {- Streams content into update-index from a list of Streamers. -} streamUpdateIndex :: Repo -> [Streamer] -> IO () -streamUpdateIndex repo as = do - (Just h, _, _, p) <- createProcess (proc "git" ps) { std_in = CreatePipe } - fileEncoding h - forM_ as (stream h) - hClose h - forceSuccessProcess p "git" ps +streamUpdateIndex repo as = + withHandle StdinHandle createProcessSuccess (proc "git" ps) $ \h -> do + fileEncoding h + forM_ as (stream h) + hClose h where ps = toCommand $ gitCommandLine params repo params = map Param ["update-index", "-z", "--index-info"] |