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

run git coprocesses with gitEnv

Browse source
This commit is contained in:
Joey Hess 2012-09-15 17:25:05 -04:00
parent e1baf48d88
commit 0b63ee6cd5
6 changed files with 12 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Git/CatFile.hs
View file

@ -29,7 +29,7 @@ import qualified Utility.CoProcess as CoProcess
type CatFileHandle = CoProcess.CoProcessHandle type CatFileHandle = CoProcess.CoProcessHandle
catFileStart :: Repo -> IO CatFileHandle catFileStart :: Repo -> IO CatFileHandle
catFileStart = CoProcess.start "git" . toCommand . gitCommandLine catFileStart = gitCoProcessStart
[ Param "cat-file" [ Param "cat-file"
, Param "--batch" , Param "--batch"
] ]

2
Git/CheckAttr.hs
View file

@ -22,7 +22,7 @@ type Attr = String
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
checkAttrStart attrs repo = do checkAttrStart attrs repo = do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
h <- CoProcess.start "git" $ toCommand $ gitCommandLine params repo h <- gitCoProcessStart params repo
return (h, attrs, cwd) return (h, attrs, cwd)
where where
params = params =

5
Git/Command.hs
View file

@ -13,6 +13,7 @@ import System.Process
import Common import Common
import Git import Git
import Git.Types import Git.Types
import qualified Utility.CoProcess as CoProcess
{- Constructs a git command line operating on the specified repo. -} {- Constructs a git command line operating on the specified repo. -}
gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
@ -80,3 +81,7 @@ reap = do
-- throws an exception when there are no child processes -- throws an exception when there are no child processes
catchDefaultIO (getAnyProcessStatus False True) Nothing catchDefaultIO (getAnyProcessStatus False True) Nothing
>>= maybe noop (const reap) >>= maybe noop (const reap)
{- Runs a git command as a coprocess. -}
gitCoProcessStart :: [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
gitCoProcessStart params repo = CoProcess.start "git" (toCommand $ gitCommandLine params repo) (gitEnv repo)

2
Git/HashObject.hs
View file

@ -17,7 +17,7 @@ import qualified Utility.CoProcess as CoProcess
type HashObjectHandle = CoProcess.CoProcessHandle type HashObjectHandle = CoProcess.CoProcessHandle
hashObjectStart :: Repo -> IO HashObjectHandle hashObjectStart :: Repo -> IO HashObjectHandle
hashObjectStart = CoProcess.start "git" . toCommand . gitCommandLine hashObjectStart = gitCoProcessStart
[ Param "hash-object" [ Param "hash-object"
, Param "-w" , Param "-w"
, Param "--stdin-paths" , Param "--stdin-paths"

6
Utility/CoProcess.hs
View file

@ -17,9 +17,9 @@ import Common
type CoProcessHandle = (ProcessHandle, Handle, Handle, CreateProcess) type CoProcessHandle = (ProcessHandle, Handle, Handle, CreateProcess)
start :: FilePath -> [String] -> IO CoProcessHandle start :: FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
start command params = do start command params env = do
(from, to, _err, pid) <- runInteractiveProcess command params Nothing Nothing (from, to, _err, pid) <- runInteractiveProcess command params Nothing env
return (pid, to, from, proc command params) return (pid, to, from, proc command params)
stop :: CoProcessHandle -> IO () stop :: CoProcessHandle -> IO ()

1
Utility/Process.hs
View file

@ -233,5 +233,6 @@ runInteractiveProcess f args c e = do
{ std_in = CreatePipe { std_in = CreatePipe
, std_out = CreatePipe , std_out = CreatePipe
, std_err = CreatePipe , std_err = CreatePipe
, env = e
} }
System.Process.runInteractiveProcess f args c e System.Process.runInteractiveProcess f args c e