summaryrefslogtreecommitdiff
path: root/Git/Config.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Git/Config.hs')
-rw-r--r--Git/Config.hs120
1 files changed, 70 insertions, 50 deletions
diff --git a/Git/Config.hs b/Git/Config.hs
index 3d62395..4b60664 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -1,32 +1,37 @@
{- git repository configuration handling
-
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
-
- - Licensed under the GNU GPL version 3 or higher.
+ - Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Git.Config where
import qualified Data.Map as M
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
import Data.Char
+import qualified System.FilePath.ByteString as P
import Common
import Git
import Git.Types
-import qualified Git.Construct
import qualified Git.Command
+import qualified Git.Construct
import Utility.UserInfo
-{- 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)
+{- Returns a single git config setting, or a fallback value if not set. -}
+get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
+get key fallback repo = M.findWithDefault fallback key (config repo)
-{- Returns a list with each line of a multiline config setting. -}
-getList :: String -> Repo -> [String]
+{- Returns a list of values. -}
+getList :: ConfigKey -> Repo -> [ConfigValue]
getList key repo = M.findWithDefault [] key (fullconfig repo)
{- Returns a single git config setting, if set. -}
-getMaybe :: String -> Repo -> Maybe String
+getMaybe :: ConfigKey -> Repo -> Maybe ConfigValue
getMaybe key repo = M.lookup key (config repo)
{- Runs git config and populates a repo with its config.
@@ -57,7 +62,7 @@ read' repo = go repo
where
params = ["config", "--null", "--list"]
p = (proc "git" params)
- { cwd = Just d
+ { cwd = Just (fromRawFilePath d)
, env = gitEnv repo
}
@@ -79,26 +84,28 @@ global = do
{- Reads git config from a handle and populates a repo with it. -}
hRead :: Repo -> Handle -> IO Repo
hRead repo h = do
- -- We use the FileSystemEncoding when reading from git-config,
- -- because it can contain arbitrary filepaths (and other strings)
- -- in any encoding.
- fileEncoding h
- val <- hGetContentsStrict h
+ val <- S.hGetContents 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 incrementally.
-}
-store :: String -> Repo -> IO Repo
+store :: S.ByteString -> Repo -> IO Repo
store s repo = do
let c = parse s
- repo' <- updateLocation $ repo
+ updateLocation $ 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 }
+
+{- Stores a single config setting in a Repo, returning the new version of
+ - the Repo. Config settings can be updated incrementally. -}
+store' :: ConfigKey -> ConfigValue -> Repo -> Repo
+store' k v repo = repo
+ { config = M.singleton k v `M.union` config repo
+ , fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)
+ }
{- Updates the location of a repo, based on its configuration.
-
@@ -108,13 +115,13 @@ store s repo = do
-}
updateLocation :: Repo -> IO Repo
updateLocation r@(Repo { location = LocalUnknown d })
- | isBare r = ifM (doesDirectoryExist dotgit)
+ | isBare r = ifM (doesDirectoryExist (fromRawFilePath dotgit))
( updateLocation' r $ Local dotgit Nothing
, updateLocation' r $ Local d Nothing
)
| otherwise = updateLocation' r $ Local dotgit (Just d)
where
- dotgit = (d </> ".git")
+ dotgit = d P.</> ".git"
updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l
updateLocation r = return r
@@ -122,53 +129,66 @@ updateLocation' :: Repo -> RepoLocation -> IO Repo
updateLocation' r l = do
l' <- case getMaybe "core.worktree" r of
Nothing -> return l
- Just d -> do
+ Just (ConfigValue d) -> do
{- core.worktree is relative to the gitdir -}
- top <- absPath $ gitdir l
- return $ l { worktree = Just $ absPathFrom top d }
+ top <- absPath $ fromRawFilePath (gitdir l)
+ let p = absPathFrom top (fromRawFilePath d)
+ return $ l { worktree = Just (toRawFilePath p) }
return $ r { location = l' }
{- 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.ByteString -> M.Map ConfigKey [ConfigValue]
parse s
- -- --list output will have an = in the first line
- | all ('=' `elem`) (take 1 ls) = sep '=' ls
+ | S.null s = M.empty
+ -- --list output will have a '=' in the first line
+ -- (The first line of --null --list output is the name of a key,
+ -- which is assumed to never contain '='.)
+ | S.elem eq firstline = sep eq $ S.split nl s
-- --null --list output separates keys from values with newlines
- | otherwise = sep '\n' $ split "\0" s
+ | otherwise = sep nl $ S.split 0 s
where
- ls = lines s
- sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
- map (separate (== c))
+ nl = fromIntegral (ord '\n')
+ eq = fromIntegral (ord '=')
+ firstline = S.takeWhile (/= nl) s
+
+ sep c = M.fromListWith (++)
+ . map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)]))
+ . map (S.break (== c))
-{- Checks if a string from git config is a true value. -}
-isTrue :: String -> Maybe Bool
-isTrue s
+{- Checks if a string from git config is a true/false value. -}
+isTrueFalse :: String -> Maybe Bool
+isTrueFalse = isTrueFalse' . ConfigValue . encodeBS'
+
+isTrueFalse' :: ConfigValue -> Maybe Bool
+isTrueFalse' (ConfigValue s)
| s' == "true" = Just True
| s' == "false" = Just False
| otherwise = Nothing
where
- s' = map toLower s
+ s' = S8.map toLower s
boolConfig :: Bool -> String
boolConfig True = "true"
boolConfig False = "false"
+boolConfig' :: Bool -> S.ByteString
+boolConfig' True = "true"
+boolConfig' False = "false"
+
isBare :: Repo -> Bool
-isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r
+isBare r = fromMaybe False $ isTrueFalse' =<< getMaybe coreBare r
-coreBare :: String
+coreBare :: ConfigKey
coreBare = "core.bare"
{- Runs a command to get the configuration of a repo,
- and returns a repo populated with the configuration, as well as the raw
- output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String))
+fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
fromPipe r cmd params = try $
withHandle StdoutHandle createProcessSuccess p $ \h -> do
- fileEncoding h
- val <- hGetContentsStrict h
+ val <- S.hGetContents h
r' <- store val r
return (r', val)
where
@@ -176,7 +196,7 @@ fromPipe r cmd params = try $
{- Reads git config from a specified file and returns the repo populated
- with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, String))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
fromFile r f = fromPipe r "git"
[ Param "config"
, Param "--file"
@@ -186,13 +206,13 @@ fromFile r f = fromPipe r "git"
{- Changes a git config setting in the specified config file.
- (Creates the file if it does not already exist.) -}
-changeFile :: FilePath -> String -> String -> IO Bool
-changeFile f k v = boolSystem "git"
+changeFile :: FilePath -> ConfigKey -> S.ByteString -> IO Bool
+changeFile f (ConfigKey k) v = boolSystem "git"
[ Param "config"
, Param "--file"
, File f
- , Param k
- , Param v
+ , Param (decodeBS' k)
+ , Param (decodeBS' v)
]
{- Unsets a git config setting, in both the git repo,
@@ -201,10 +221,10 @@ changeFile f k v = boolSystem "git"
- If unsetting the config fails, including in a read-only repo, or
- when the config is not set, returns Nothing.
-}
-unset :: String -> Repo -> IO (Maybe Repo)
-unset k r = ifM (Git.Command.runBool ps r)
- ( return $ Just $ r { config = M.delete k (config r) }
+unset :: ConfigKey -> Repo -> IO (Maybe Repo)
+unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r)
+ ( return $ Just $ r { config = M.delete ck (config r) }
, return Nothing
)
where
- ps = [Param "config", Param "--unset-all", Param k]
+ ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-03 12:31:26 +0000