refactor

Annex/Index.hs

@@ -5,19 +5,14 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
+module Annex.Index (withIndexFile) where
-
-module Annex.Index (
-	withIndexFile,
-	addGitEnv,
-) where
 
 import qualified Control.Exception as E
 
 import Annex.Common
 import Git.Types
+import Git.Env
 import qualified Annex
-import Utility.Env
 
 {- Runs an action using a different git index file. -}
 withIndexFile :: FilePath -> Annex a -> Annex a
@@ -30,23 +25,3 @@ withIndexFile f a = do
 		a
 	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
 	either E.throw return r
-
-addGitEnv :: Repo -> String -> String -> IO Repo
-addGitEnv g var val = do
-	e <- maybe copyenv return (gitEnv g)
-	let e' = addEntry var val e
-	return $ g { gitEnv = Just e' }
-  where
-	copyenv = do
-#ifdef __ANDROID__
-		{- This should not be necessary on Android, but there is some
-		 - weird getEnvironment breakage. See
-		 - https://github.com/neurocyte/ghc-android/issues/7
-		 - Use getEnv to get some key environment variables that
-		 - git expects to have. -}
-		let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
-		let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
-		liftIO $ catMaybes <$> forM keyenv getEnvPair
-#else
-		liftIO getEnvironment
-#endif

Annex/Ssh.hs

@@ -34,7 +34,7 @@ import Config
 import Annex.Path
 import Utility.Env
 import Types.CleanupActions
-import Annex.Index (addGitEnv)
+import Git.Env
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 import Annex.LockPool

Git/Env.hs

@@ -0,0 +1,38 @@
+{- Adjusting the environment while running git commands.
+ -
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Git.Env where
+
+import Git
+import Utility.Env
+
+{- Adjusts the gitEnv of a Repo. Copies the system environment if the repo
+ - does not have any gitEnv yet. -}
+adjustGitEnv :: Repo -> ([(String, String)] -> [(String, String)]) -> IO Repo
+adjustGitEnv g adj = do
+	e <- maybe copyenv return (gitEnv g)
+	let e' = adj e
+	return $ g { gitEnv = Just e' }
+  where
+	copyenv = do
+#ifdef __ANDROID__
+		{- This should not be necessary on Android, but there is some
+		 - weird getEnvironment breakage. See
+		 - https://github.com/neurocyte/ghc-android/issues/7
+		 - Use getEnv to get some key environment variables that
+		 - git expects to have. -}
+		let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
+		let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
+		catMaybes <$> forM keyenv getEnvPair
+#else
+		getEnvironment
+#endif
+
+addGitEnv :: Repo -> String -> String -> IO Repo
+addGitEnv g var val = adjustGitEnv g (addEntry var val)