diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Command.hs | 18 | ||||
| -rw-r--r-- | Git/Config.hs | 7 | ||||
| -rw-r--r-- | Git/Construct.hs | 1 | ||||
| -rw-r--r-- | Git/Index.hs | 5 | ||||
| -rw-r--r-- | Git/Queue.hs | 4 | ||||
| -rw-r--r-- | Git/Types.hs | 16 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 10 |
7 files changed, 41 insertions, 20 deletions
diff --git a/Git/Command.hs b/Git/Command.hs index cd6c98d33..04b0723d0 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -8,6 +8,7 @@ module Git.Command where import System.Posix.Process (getAnyProcessStatus) +import System.Process import Common import Git @@ -26,7 +27,9 @@ gitCommandLine _ repo = assertLocal repo $ error "internal" {- Runs git in the specified repo. -} runBool :: String -> [CommandParam] -> Repo -> IO Bool runBool subcommand params repo = assertLocal repo $ - boolSystem "git" $ gitCommandLine (Param subcommand : params) repo + boolSystemEnv "git" + (gitCommandLine (Param subcommand : params) repo) + (gitEnv repo) {- Runs git in the specified repo, throwing an error if it fails. -} run :: String -> [CommandParam] -> Repo -> IO () @@ -45,14 +48,23 @@ pipeRead params repo = assertLocal repo $ fileEncoding h hGetContents h where - p = proc "git" $ toCommand $ gitCommandLine params repo + p = (proc "git" $ toCommand $ gitCommandLine params repo) + { env = gitEnv 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 - strictly. -} pipeWriteRead :: [CommandParam] -> String -> Repo -> IO String pipeWriteRead params s repo = assertLocal repo $ - writeReadProcess "git" (toCommand $ gitCommandLine params repo) s + writeReadProcessEnv "git" (toCommand $ gitCommandLine params repo) + (gitEnv repo) s + +{- 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) + { env = gitEnv repo } {- Reads null terminated output of a git command (as enabled by the -z - parameter), and splits it. -} diff --git a/Git/Config.hs b/Git/Config.hs index 0a720c1c0..fb0c24bab 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 (cwd) +import System.Process (cwd, env) import Common import Git @@ -52,7 +52,10 @@ read' repo = go repo hRead repo where params = ["config", "--null", "--list"] - p = (proc "git" params) { cwd = Just d } + p = (proc "git" params) + { cwd = Just d + , env = gitEnv repo + } {- Gets the global git config, returning a dummy Repo containing it. -} global :: IO Repo diff --git a/Git/Construct.hs b/Git/Construct.hs index b809d7318..90bedbde1 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -225,6 +225,7 @@ newFrom l = return Repo , fullconfig = M.empty , remotes = [] , remoteName = Nothing + , gitEnv = Nothing } diff --git a/Git/Index.hs b/Git/Index.hs index aaf54e032..d6fa4ee6c 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -12,7 +12,10 @@ import System.Posix.Env (setEnv, unsetEnv, getEnv) {- Forces git to use the specified index file. - - Returns an action that will reset back to the default - - index file. -} + - index file. + - + - Warning: Not thread safe. + -} override :: FilePath -> IO (IO ()) override index = do res <- getEnv var diff --git a/Git/Queue.hs b/Git/Queue.hs index f515ad104..9f7a44882 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -19,6 +19,7 @@ module Git.Queue ( import qualified Data.Map as M import System.IO +import System.Process import Data.String.Utils import Utility.SafeCommand @@ -148,11 +149,12 @@ runAction repo (UpdateIndexAction streamers) = -- list is stored in reverse order Git.UpdateIndex.streamUpdateIndex repo $ reverse streamers runAction repo action@(CommandAction {}) = - withHandle StdinHandle createProcessSuccess (proc "xargs" params) $ \h -> do + withHandle StdinHandle createProcessSuccess p $ \h -> do fileEncoding h hPutStr h $ join "\0" $ getFiles action hClose h where + p = (proc "xargs" params) { env = gitEnv repo } params = "-0":"git":baseparams baseparams = toCommand $ gitCommandLine (Param (getSubcommand action):getParams action) repo diff --git a/Git/Types.hs b/Git/Types.hs index 0c37427c7..57e5ca6e2 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -27,15 +27,17 @@ data RepoLocation | Unknown deriving (Show, Eq) -data Repo = Repo { - location :: RepoLocation, - config :: M.Map String String, +data Repo = Repo + { location :: RepoLocation + , config :: M.Map String String -- a given git config key can actually have multiple values - fullconfig :: M.Map String [String], - remotes :: [Repo], + , fullconfig :: M.Map String [String] + , remotes :: [Repo] -- remoteName holds the name used for this repo in remotes - remoteName :: Maybe String -} deriving (Show, Eq) + , remoteName :: Maybe String + -- alternate environment to use when running git commands + , gitEnv :: Maybe [(String, String)] + } deriving (Show, Eq) {- A git ref. Can be a sha1, or a branch or tag name. -} newtype Ref = Ref String diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 929448729..69e5f1b3d 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -34,13 +34,11 @@ pureStreamer !s = \streamer -> streamer s {- Streams content into update-index from a list of Streamers. -} streamUpdateIndex :: Repo -> [Streamer] -> IO () -streamUpdateIndex repo as = - withHandle StdinHandle createProcessSuccess (proc "git" ps) $ \h -> do - fileEncoding h - forM_ as (stream h) - hClose h +streamUpdateIndex repo as = pipeWrite params repo $ \h -> do + fileEncoding h + forM_ as (stream h) + hClose h where - ps = toCommand $ gitCommandLine params repo params = map Param ["update-index", "-z", "--index-info"] stream h a = a (streamer h) streamer h s = do |