summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
Diffstat (limited to 'Git')
-rw-r--r--Git/Command.hs13
-rw-r--r--Git/Config.hs15
-rw-r--r--Git/Queue.hs13
-rw-r--r--Git/UpdateIndex.hs13
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"]