5287d1dc3f
Consider this git config --list case: url.git+ssh://git@example.com/.insteadOf=gl url.git+ssh://git@example.com/.insteadOf=shared Since config is stored in a Map, only the last of the values for this key was stored and available for use by the insteadOf code. But that is wrong; git allows either "gl" or "shared" to be used in an url and the insteadOf value to be substituted in. To support this, it seems best to keep the existing config map as-is, and add a second map that accumulates a list of multiple values for config keys. This new fullconfig map can be used in the rare places where multiple values for a key make sense, without needing to complicate everything else. Haskell's laziness and data sharing keep the overhead of adding this second map low.
65 lines
2 KiB
Haskell
65 lines
2 KiB
Haskell
{- git repository configuration handling
|
|
-
|
|
- Copyright 2010,2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.Config where
|
|
|
|
import System.Posix.Directory
|
|
import Control.Exception (bracket_)
|
|
import qualified Data.Map as M
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Types
|
|
import qualified Git.Construct
|
|
|
|
{- Returns a single git config setting, or a default value if not set. -}
|
|
get :: String -> String -> Repo -> String
|
|
get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
|
|
|
|
{- Runs git config and populates a repo with its config. -}
|
|
read :: Repo -> IO Repo
|
|
read repo@(Repo { location = Dir d }) = do
|
|
{- Cannot use pipeRead because it relies on the config having
|
|
been already read. Instead, chdir to the repo. -}
|
|
cwd <- getCurrentDirectory
|
|
bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) $
|
|
pOpen ReadFromPipe "git" ["config", "--null", "--list"] $
|
|
hRead repo
|
|
read r = assertLocal r $ error "internal"
|
|
|
|
{- Reads git config from a handle and populates a repo with it. -}
|
|
hRead :: Repo -> Handle -> IO Repo
|
|
hRead repo h = do
|
|
val <- hGetContentsStrict h
|
|
store val repo
|
|
|
|
{- Stores a git config into a repo, returning the new version of the repo.
|
|
- The git config may be multiple lines, or a single line. Config settings
|
|
- can be updated inrementally. -}
|
|
store :: String -> Repo -> IO Repo
|
|
store s repo = do
|
|
let c = parse s
|
|
let repo' = repo
|
|
{ config = (M.map Prelude.head c) `M.union` config repo
|
|
, fullconfig = M.unionWith (++) c (fullconfig repo)
|
|
}
|
|
rs <- Git.Construct.fromRemotes repo'
|
|
return $ repo' { remotes = rs }
|
|
|
|
{- Parses git config --list or git config --null --list output into a
|
|
- config map. -}
|
|
parse :: String -> M.Map String [String]
|
|
parse [] = M.empty
|
|
parse s
|
|
-- --list output will have an = in the first line
|
|
| all ('=' `elem`) (take 1 ls) = sep '=' ls
|
|
-- --null --list output separates keys from values with newlines
|
|
| otherwise = sep '\n' $ split "\0" s
|
|
where
|
|
ls = lines s
|
|
sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
|
|
map (separate (== c))
|