2011-12-13 19:05:07 +00:00
|
|
|
{- git repository configuration handling
|
|
|
|
-
|
|
|
|
- Copyright 2010,2011 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
2011-12-15 20:04:08 +00:00
|
|
|
module Git.Config where
|
2011-12-13 19:05:07 +00:00
|
|
|
|
|
|
|
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)
|
|
|
|
|
2012-01-10 03:31:44 +00:00
|
|
|
{- Returns a single git config setting, if set. -}
|
|
|
|
getMaybe :: String -> Repo -> Maybe String
|
|
|
|
getMaybe key repo = M.lookup key (config repo)
|
|
|
|
|
2011-12-13 19:05:07 +00:00
|
|
|
{- Runs git config and populates a repo with its config. -}
|
|
|
|
read :: Repo -> IO Repo
|
2012-03-16 05:59:07 +00:00
|
|
|
read repo@(Repo { location = Dir d }) = bracketcd d $
|
2011-12-13 19:05:07 +00:00
|
|
|
{- Cannot use pipeRead because it relies on the config having
|
|
|
|
been already read. Instead, chdir to the repo. -}
|
2012-03-16 05:59:07 +00:00
|
|
|
pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo
|
2012-01-14 15:42:51 +00:00
|
|
|
where
|
2012-03-16 05:59:07 +00:00
|
|
|
bracketcd to a = bracketcd' to a =<< getCurrentDirectory
|
|
|
|
bracketcd' to a cwd
|
|
|
|
| dirContains to cwd = a
|
|
|
|
| otherwise = bracket_ (changeWorkingDirectory to) (changeWorkingDirectory cwd) a
|
2011-12-31 08:50:39 +00:00
|
|
|
read r = assertLocal r $
|
|
|
|
error $ "internal error; trying to read config of " ++ show r
|
2011-12-13 19:05:07 +00:00
|
|
|
|
|
|
|
{- 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
|
2011-12-30 18:07:17 +00:00
|
|
|
let c = parse s
|
|
|
|
let repo' = repo
|
|
|
|
{ config = (M.map Prelude.head c) `M.union` config repo
|
|
|
|
, fullconfig = M.unionWith (++) c (fullconfig repo)
|
|
|
|
}
|
2011-12-13 19:05:07 +00:00
|
|
|
rs <- Git.Construct.fromRemotes repo'
|
|
|
|
return $ repo' { remotes = rs }
|
|
|
|
|
2011-12-15 16:46:04 +00:00
|
|
|
{- Parses git config --list or git config --null --list output into a
|
|
|
|
- config map. -}
|
2011-12-30 18:07:17 +00:00
|
|
|
parse :: String -> M.Map String [String]
|
2011-12-15 16:46:04 +00:00
|
|
|
parse [] = M.empty
|
|
|
|
parse s
|
|
|
|
-- --list output will have an = in the first line
|
2011-12-15 20:04:08 +00:00
|
|
|
| all ('=' `elem`) (take 1 ls) = sep '=' ls
|
2011-12-15 16:46:04 +00:00
|
|
|
-- --null --list output separates keys from values with newlines
|
2011-12-15 17:05:47 +00:00
|
|
|
| otherwise = sep '\n' $ split "\0" s
|
2011-12-13 19:05:07 +00:00
|
|
|
where
|
2011-12-15 16:46:04 +00:00
|
|
|
ls = lines s
|
2011-12-30 18:07:17 +00:00
|
|
|
sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
|
|
|
|
map (separate (== c))
|