type based git config handling

Now there's a Config type, that's extracted from the git config at startup.
Note that laziness means that individual config values are only looked up
and parsed on demand, and so we get implicit memoization for all of them.
So this is not only prettier and more type safe, it optimises several
places that didn't have explicit memoization before. As well as getting rid
of the ugly explicit memoization code.

Not yet done for annex.<remote>.* configuration settings.
This commit is contained in:
Joey Hess 2012-12-29 23:10:18 -04:00
parent b62753c475
commit 7f7c31df1c
23 changed files with 151 additions and 103 deletions

View file

@ -12,7 +12,6 @@ import qualified Git
import qualified Git.Config
import qualified Git.Command
import qualified Annex
import Utility.DataUnits
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
@ -21,8 +20,7 @@ data ConfigKey = ConfigKey String
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run "config" [Param key, Param value]
newg <- inRepo Git.Config.reRead
Annex.changeState $ \s -> s { Annex.repo = newg }
Annex.changeGitRepo =<< inRepo Git.Config.reRead
{- Unsets a git config setting. (Leaves it in state currently.) -}
unsetConfig :: ConfigKey -> Annex ()
@ -93,49 +91,28 @@ repoSyncable :: Git.Repo -> Annex Bool
repoSyncable r = fromMaybe True . Git.Config.isTrue
<$> getRemoteConfig r "sync" ""
{- If a value is specified, it is used; otherwise the default is looked up
- in git config. forcenumcopies overrides everything. -}
getNumCopies :: Maybe Int -> Annex Int
getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
where
use (Just n) = return n
use Nothing = perhaps (return 1) =<<
readish <$> getConfig (annexConfig "numcopies") "1"
perhaps fallback = maybe fallback (return . id)
{- Gets the trust level set for a remote in git config. -}
getTrustLevel :: Git.Repo -> Annex (Maybe String)
getTrustLevel r = fromRepo $ Git.Config.getMaybe key
where
(ConfigKey key) = remoteConfig r "trustlevel"
{- Gets annex.diskreserve setting. -}
getDiskReserve :: Annex Integer
getDiskReserve = fromMaybe megabyte . readSize dataUnits
<$> getConfig (annexConfig "diskreserve") ""
where
megabyte = 1000000
getNumCopies :: Maybe Int -> Annex Int
getNumCopies (Just v) = return v
getNumCopies Nothing = annexNumCopies <$> Annex.getConfig
{- Gets annex.direct setting, cached for speed. -}
isDirect :: Annex Bool
isDirect = maybe fromconfig return =<< Annex.getState Annex.direct
where
fromconfig = do
direct <- fromMaybe False . Git.Config.isTrue <$>
getConfig (annexConfig "direct") ""
Annex.changeState $ \s -> s { Annex.direct = Just direct }
return direct
isDirect = annexDirect <$> Annex.getConfig
setDirect :: Bool -> Annex ()
setDirect b = do
setConfig (annexConfig "direct") (if b then "true" else "false")
Annex.changeState $ \s -> s { Annex.direct = Just b }
setConfig (annexConfig "direct") $ if b then "true" else "false"
Annex.changeConfig $ \c -> c { annexDirect = b }
{- Gets annex.httpheaders or annex.httpheaders-command setting,
- splitting it into lines. -}
{- Gets the http headers to use. -}
getHttpHeaders :: Annex [String]
getHttpHeaders = do
cmd <- getConfig (annexConfig "http-headers-command") ""
if null cmd
then fromRepo $ Git.Config.getList "annex.http-headers"
else lines <$> liftIO (readProcess "sh" ["-c", cmd])
v <- annexHttpHeadersCommand <$> Annex.getConfig
case v of
Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
Nothing -> annexHttpHeaders <$> Annex.getConfig