diff options
Diffstat (limited to 'Git/Config.hs')
| -rw-r--r-- | Git/Config.hs | 62 |
1 files changed, 45 insertions, 17 deletions
diff --git a/Git/Config.hs b/Git/Config.hs index 38b9ade45..e37b43707 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -1,15 +1,14 @@ {- git repository configuration handling - - - Copyright 2010,2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 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 Data.Char import Common import Git @@ -30,17 +29,14 @@ getMaybe key repo = M.lookup key (config repo) {- Runs git config and populates a repo with its config. -} read :: Repo -> IO Repo -read repo@(Repo { location = Dir d }) = bracketcd d $ - {- Cannot use pipeRead because it relies on the config having - been already read. Instead, chdir to the repo. -} +read repo@(Repo { location = Local { gitdir = d } }) = read' repo d +read repo@(Repo { location = LocalUnknown d }) = read' repo d +read r = assertLocal r $ error "internal" +{- Cannot use pipeRead because it relies on the config having + been already read. Instead, chdir to the repo. -} +read' :: Repo -> FilePath -> IO Repo +read' repo d = bracketCd d $ pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo - where - bracketcd to a = bracketcd' to a =<< getCurrentDirectory - bracketcd' to a cwd - | dirContains to cwd = a - | otherwise = bracket_ (changeWorkingDirectory to) (changeWorkingDirectory cwd) a -read r = assertLocal r $ - error $ "internal error; trying to read config of " ++ show r {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo @@ -48,19 +44,42 @@ 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. -} +{- 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 incrementally. + -} store :: String -> Repo -> IO Repo store s repo = do let c = parse s - let repo' = repo + let repo' = updateLocation $ repo { config = (M.map Prelude.head c) `M.union` config repo , fullconfig = M.unionWith (++) c (fullconfig repo) } + print repo' rs <- Git.Construct.fromRemotes repo' return $ repo' { remotes = rs } +{- Updates the location of a repo, based on its configuration. + - + - Git.Construct makes LocalUknown repos, of which only a directory is + - known. Once the config is read, this can be fixed up to a Local repo, + - based on the core.bare and core.worktree settings. + -} +updateLocation :: Repo -> Repo +updateLocation r = go $ location r + where + go (LocalUnknown d) + | isbare = ret $ Local d Nothing + | otherwise = ret $ Local (d </> ".git") (Just d) + go l@(Local {}) = ret l + go _ = r + isbare = fromMaybe False $ isTrue =<< getMaybe "core.bare" r + ret l = r { location = l' } + where + l' = maybe l (setworktree l) $ + getMaybe "core.worktree" r + setworktree l t = l { worktree = Just t } + {- Parses git config --list or git config --null --list output into a - config map. -} parse :: String -> M.Map String [String] @@ -74,3 +93,12 @@ parse s ls = lines s sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) . map (separate (== c)) + +{- Checks if a string from git config is a true value. -} +isTrue :: String -> Maybe Bool +isTrue s + | s' == "true" = Just True + | s' == "false" = Just False + | otherwise = Nothing + where + s' = map toLower s |