avoid needing a build-dep on hxt for Data.AssocList
This commit is contained in:
parent
d0b51099a4
commit
207ac67aaa
6 changed files with 25 additions and 12 deletions
|
@ -29,7 +29,6 @@ module Annex.Branch (
|
||||||
import qualified Data.ByteString.Lazy.Char8 as L
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.AssocList as A
|
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
@ -346,7 +345,7 @@ withIndex' bootstrapping a = do
|
||||||
let e' = ("GIT_INDEX_FILE", f):e
|
let e' = ("GIT_INDEX_FILE", f):e
|
||||||
#else
|
#else
|
||||||
e <- liftIO getEnvironment
|
e <- liftIO getEnvironment
|
||||||
let e' = A.addEntry "GIT_INDEX_FILE" f e
|
let e' = addEntry "GIT_INDEX_FILE" f e
|
||||||
#endif
|
#endif
|
||||||
let g' = g { gitEnv = Just e' }
|
let g' = g { gitEnv = Just e' }
|
||||||
|
|
||||||
|
|
|
@ -43,7 +43,6 @@ import Control.Concurrent
|
||||||
import System.Timeout
|
import System.Timeout
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.AssocList as A
|
|
||||||
|
|
||||||
{- Largest chunk of data to send in a single XMPP message. -}
|
{- Largest chunk of data to send in a single XMPP message. -}
|
||||||
chunkSize :: Int
|
chunkSize :: Int
|
||||||
|
@ -115,7 +114,7 @@ xmppPush cid gitpush = do
|
||||||
|
|
||||||
env <- liftIO getEnvironment
|
env <- liftIO getEnvironment
|
||||||
path <- liftIO getSearchPath
|
path <- liftIO getSearchPath
|
||||||
let myenv = A.addEntries
|
let myenv = addEntries
|
||||||
[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
|
[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
|
||||||
, (relayIn, show inf)
|
, (relayIn, show inf)
|
||||||
, (relayOut, show outf)
|
, (relayOut, show outf)
|
||||||
|
|
|
@ -54,7 +54,6 @@ import Control.Concurrent
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
import System.Process (std_in, std_err)
|
import System.Process (std_in, std_err)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.AssocList as A
|
|
||||||
import Control.Exception.Extensible
|
import Control.Exception.Extensible
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
|
@ -417,7 +416,7 @@ fsckOnRemote r params
|
||||||
program <- readProgramFile
|
program <- readProgramFile
|
||||||
r' <- Git.Config.read r
|
r' <- Git.Config.read r
|
||||||
env <- getEnvironment
|
env <- getEnvironment
|
||||||
let env' = A.addEntries
|
let env' = addEntries
|
||||||
[ ("GIT_WORK_TREE", Git.repoPath r')
|
[ ("GIT_WORK_TREE", Git.repoPath r')
|
||||||
, ("GIT_DIR", Git.localGitDir r')
|
, ("GIT_DIR", Git.localGitDir r')
|
||||||
] env
|
] env
|
||||||
|
|
|
@ -9,8 +9,6 @@ module Remote.Glacier (remote, jobList) where
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.AssocList as A
|
|
||||||
import System.Environment
|
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
@ -27,6 +25,7 @@ import Utility.Metered
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
|
import Utility.Env
|
||||||
|
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
|
@ -233,7 +232,7 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
|
||||||
go Nothing = return Nothing
|
go Nothing = return Nothing
|
||||||
go (Just (user, pass)) = do
|
go (Just (user, pass)) = do
|
||||||
e <- liftIO getEnvironment
|
e <- liftIO getEnvironment
|
||||||
return $ Just $ A.addEntries [(uk, user), (pk, pass)] e
|
return $ Just $ addEntries [(uk, user), (pk, pass)] e
|
||||||
|
|
||||||
creds = AWS.creds u
|
creds = AWS.creds u
|
||||||
(uk, pk) = credPairEnvironment creds
|
(uk, pk) = credPairEnvironment creds
|
||||||
|
|
|
@ -9,8 +9,6 @@ module Remote.Hook (remote) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.AssocList as A
|
|
||||||
import System.Environment
|
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
|
@ -24,6 +22,7 @@ import Remote.Helper.Special
|
||||||
import Remote.Helper.Encryptable
|
import Remote.Helper.Encryptable
|
||||||
import Crypto
|
import Crypto
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
|
import Utility.Env
|
||||||
|
|
||||||
type Action = String
|
type Action = String
|
||||||
type HookName = String
|
type HookName = String
|
||||||
|
@ -78,7 +77,7 @@ hookSetup mu c = do
|
||||||
hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
|
||||||
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
|
||||||
where
|
where
|
||||||
mergeenv l = A.addEntries l <$> getEnvironment
|
mergeenv l = addEntries l <$> getEnvironment
|
||||||
env s v = ("ANNEX_" ++ s, v)
|
env s v = ("ANNEX_" ++ s, v)
|
||||||
keyenv = catMaybes
|
keyenv = catMaybes
|
||||||
[ Just $ env "KEY" (key2file k)
|
[ Just $ env "KEY" (key2file k)
|
||||||
|
|
|
@ -61,3 +61,21 @@ unsetEnv var = do
|
||||||
#else
|
#else
|
||||||
unsetEnv _ = return False
|
unsetEnv _ = return False
|
||||||
#endif
|
#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
|
||||||
|
|
Loading…
Add table
Reference in a new issue