git-annex/Config.hs
Joey Hess c78b9b55b6
rename changeGitConfig to overrideGitConfig and avoid unncessary calls
It's important that it be clear that it overrides a config, such that
reloading the git config won't change it, and in particular, setConfig
won't change it.

Most of the calls to changeGitConfig were actually after setConfig,
which was redundant and unncessary. So removed those.

The only remaining one, besides --debug, is in the handling of
repository-global config values. That one's ok, because the
way mergeGitConfig is implemented, it does not override any value that
is set in git config. If a value with a repo-global setting was passed
to setConfig, it would set it in the git config, reload the git config,
re-apply mergeGitConfig, and use the newly set value, which is the right
thing.
2020-02-27 01:11:53 -04:00

115 lines
3.6 KiB
Haskell

{- Git configuration
-
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Config where
import Annex.Common
import qualified Git
import qualified Git.Config
import qualified Git.Command
import qualified Annex
import Config.Cost
import Config.DynamicConfig
import Types.Availability
import Git.Types
import qualified Types.Remote as Remote
import qualified Data.ByteString as S
type UnqualifiedConfigKey = S.ByteString
{- Looks up a setting in git config. This is not as efficient as using the
- GitConfig type. -}
getConfig :: ConfigKey -> ConfigValue -> Annex ConfigValue
getConfig key d = fromRepo $ Git.Config.get key d
getConfigMaybe :: ConfigKey -> Annex (Maybe ConfigValue)
getConfigMaybe key = fromRepo $ Git.Config.getMaybe key
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run
[ Param "config"
, Param (decodeBS' key)
, Param value
]
reloadConfig
reloadConfig :: Annex ()
reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead
{- Unsets a git config setting. (Leaves it in state.) -}
unsetConfig :: ConfigKey -> Annex ()
unsetConfig key = void $ inRepo $ Git.Config.unset key
class RemoteNameable r where
getRemoteName :: r -> RemoteName
instance RemoteNameable Git.Repo where
getRemoteName r = fromMaybe "" (Git.remoteName r)
instance RemoteNameable RemoteName where
getRemoteName = id
instance RemoteNameable Remote where
getRemoteName = Remote.name
{- A per-remote config setting in git config. -}
remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
"remote." <> encodeBS' (getRemoteName r) <> "." <> key
{- A per-remote config annex setting in git config. -}
remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)
{- A global annex setting in git config. -}
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey ("annex." <> key)
{- Calculates cost for a remote. Either the specific default, or as configured
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
- is set and prints a number, that is used. -}
remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
remoteCost c d = fromMaybe d <$> remoteCost' c
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
setRemoteCost :: Git.Repo -> Cost -> Annex ()
setRemoteCost r c = setConfig (remoteAnnexConfig r "cost") (show c)
setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
setRemoteAvailability r c = setConfig (remoteAnnexConfig r "availability") (show c)
setRemoteIgnore :: Git.Repo -> Bool -> Annex ()
setRemoteIgnore r b = setConfig (remoteAnnexConfig r "ignore") (Git.Config.boolConfig b)
setRemoteBare :: Git.Repo -> Bool -> Annex ()
setRemoteBare r b = setConfig (remoteAnnexConfig r "bare") (Git.Config.boolConfig b)
isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare
isDirect :: Annex Bool
isDirect = annexDirect <$> Annex.getGitConfig
crippledFileSystem :: Annex Bool
crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig
setCrippledFileSystem :: Bool -> Annex ()
setCrippledFileSystem b =
setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b)
yesNo :: String -> Maybe Bool
yesNo "yes" = Just True
yesNo "no" = Just False
yesNo _ = Nothing