avoid needing a build-dep on hxt for Data.AssocList

6 files changed, 25 insertions, 12 deletions

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 5a9522689..3256b65fb 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -29,7 +29,6 @@ module Annex.Branch (
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.AssocList as A
 import qualified Control.Exception as E
 
 import Common.Annex
@@ -346,7 +345,7 @@ withIndex' bootstrapping a = do
 	let e' = ("GIT_INDEX_FILE", f):e
 #else
 	e <- liftIO getEnvironment
-	let e' = A.addEntry "GIT_INDEX_FILE" f e
+	let e' = addEntry "GIT_INDEX_FILE" f e
 #endif
 	let g' = g { gitEnv = Just e' }
 
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 54cc6596f..22c3a125e 100644
--- a/Assistant/XMPP/Git.hs
+++ b/Assistant/XMPP/Git.hs
@@ -43,7 +43,6 @@ import Control.Concurrent
 import System.Timeout
 import qualified Data.ByteString as B
 import qualified Data.Map as M
-import qualified Data.AssocList as A
 
 {- Largest chunk of data to send in a single XMPP message. -}
 chunkSize :: Int
@@ -115,7 +114,7 @@ xmppPush cid gitpush = do
 
 	env <- liftIO getEnvironment
 	path <- liftIO getSearchPath
-	let myenv = A.addEntries
+	let myenv = addEntries
 		[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
 		, (relayIn, show inf)
 		, (relayOut, show outf)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 4c6b95f60..e292707e4 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -54,7 +54,6 @@ import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import System.Process (std_in, std_err)
 import qualified Data.Map as M
-import qualified Data.AssocList as A
 import Control.Exception.Extensible
 
 remote :: RemoteType
@@ -417,7 +416,7 @@ fsckOnRemote r params
 		program <- readProgramFile
 		r' <- Git.Config.read r
 		env <- getEnvironment
-		let env' = A.addEntries 
+		let env' = addEntries 
 			[ ("GIT_WORK_TREE", Git.repoPath r')
 			, ("GIT_DIR", Git.localGitDir r')
 			] env
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index f0ff8d738..3bb92e2f6 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -9,8 +9,6 @@ module Remote.Glacier (remote, jobList) where
 
 import qualified Data.Map as M
 import qualified Data.Text as T
-import Data.AssocList as A
-import System.Environment
 
 import Common.Annex
 import Types.Remote
@@ -27,6 +25,7 @@ import Utility.Metered
 import qualified Annex
 import Annex.Content
 import Annex.UUID
+import Utility.Env
 
 import System.Process
 
@@ -233,7 +232,7 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
 	go Nothing = return Nothing
 	go (Just (user, pass)) = do
 		e <- liftIO getEnvironment
-		return $ Just $ A.addEntries [(uk, user), (pk, pass)] e
+		return $ Just $ addEntries [(uk, user), (pk, pass)] e
 
 	creds = AWS.creds u
 	(uk, pk) = credPairEnvironment creds
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index d2ce48ddb..1fcb2912f 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -9,8 +9,6 @@ module Remote.Hook (remote) where
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
-import qualified Data.AssocList as A
-import System.Environment
 
 import Common.Annex
 import Types.Remote
@@ -24,6 +22,7 @@ import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
 import Utility.Metered
+import Utility.Env
 
 type Action = String
 type HookName = String
@@ -78,7 +77,7 @@ hookSetup mu c = do
 hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
 hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
   where
-	mergeenv l = A.addEntries l <$> getEnvironment
+	mergeenv l = addEntries l <$> getEnvironment
 	env s v = ("ANNEX_" ++ s, v)
 	keyenv = catMaybes
 		[ Just $ env "KEY" (key2file k)
diff --git a/Utility/Env.hs b/Utility/Env.hs
index cb738732f..90ed58f6b 100644
--- a/Utility/Env.hs
+++ b/Utility/Env.hs
@@ -61,3 +61,21 @@ unsetEnv var = do
 #else
 unsetEnv _ = return False
 #endif
+
+{- Adds the environment variable to the input environment. If already
+ - present in the list, removes the old value.
+ -
+ - This does not really belong here, but Data.AssocList is for some reason
+ - buried inside hxt.
+ -}
+addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)]
+addEntry k v l = ( (k,v) : ) $! delEntry k l
+
+addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]
+addEntries = foldr (.) id . map (uncurry addEntry) . reverse
+
+delEntry :: Eq k => k -> [(k, v)] -> [(k, v)]
+delEntry _ []   = []
+delEntry k (x@(k1,_) : rest)
+	| k == k1 = rest
+	| otherwise = ( x : ) $! delEntry k rest