aboutsummaryrefslogtreecommitdiff
path: root/Config.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-01-01 13:52:47 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-01-01 13:58:14 -0400
commit18a3a186e9cdb69ee503d961d8285a341d818c48 (patch)
treed415a97f6c65e2268c948c6c2425d1b94b16df92 /Config.hs
parentb6e3e7516dfdc054b9e1a281b2e49b392d235ee2 (diff)
type based git config handling for remotes
Still a couple of places that use git config ad-hoc, but this is most of it done.
Diffstat (limited to 'Config.hs')
-rw-r--r--Config.hs55
1 files changed, 16 insertions, 39 deletions
diff --git a/Config.hs b/Config.hs
index afda3e7cb..f2f12a266 100644
--- a/Config.hs
+++ b/Config.hs
@@ -16,6 +16,10 @@ import qualified Annex
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
+{- Looks up a setting in git config. -}
+getConfig :: ConfigKey -> String -> Annex String
+getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
+
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
@@ -27,16 +31,6 @@ unsetConfig :: ConfigKey -> Annex ()
unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config"
[Param "--unset", Param key]
-{- Looks up a setting in git config. -}
-getConfig :: ConfigKey -> String -> Annex String
-getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
-
-{- Looks up a per-remote config setting in git config.
- - Failing that, tries looking for a global config option. -}
-getRemoteConfig :: Git.Repo -> UnqualifiedConfigKey -> String -> Annex String
-getRemoteConfig r key def =
- getConfig (remoteConfig r key) =<< getConfig (annexConfig key) def
-
{- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
@@ -46,16 +40,15 @@ remoteConfig r key = ConfigKey $
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey $ "annex." ++ key
-{- Calculates cost for a remote. Either the default, or as configured
+{- 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 :: Git.Repo -> Int -> Annex Int
-remoteCost r def = do
- cmd <- getRemoteConfig r "cost-command" ""
- (fromMaybe def . readish) <$>
- if not $ null cmd
- then liftIO $ readProcess "sh" ["-c", cmd]
- else getRemoteConfig r "cost" ""
+remoteCost :: RemoteGitConfig -> Int -> Annex Int
+remoteCost c def = case remoteAnnexCostCommand c of
+ Just cmd | not (null cmd) -> liftIO $
+ (fromMaybe def . readish) <$>
+ readProcess "sh" ["-c", cmd]
+ _ -> return $ fromMaybe def $ remoteAnnexCost c
cheapRemoteCost :: Int
cheapRemoteCost = 100
@@ -81,38 +74,22 @@ prop_cost_sane = False `notElem`
, semiCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
]
-{- Checks if a repo should be ignored. -}
-repoNotIgnored :: Git.Repo -> Annex Bool
-repoNotIgnored r = not . fromMaybe False . Git.Config.isTrue
- <$> getRemoteConfig r "ignore" ""
-
-{- Checks if a repo should be synced. -}
-repoSyncable :: Git.Repo -> Annex Bool
-repoSyncable r = fromMaybe True . Git.Config.isTrue
- <$> getRemoteConfig r "sync" ""
-
-{- 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"
-
getNumCopies :: Maybe Int -> Annex Int
getNumCopies (Just v) = return v
-getNumCopies Nothing = annexNumCopies <$> Annex.getConfig
+getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig
isDirect :: Annex Bool
-isDirect = annexDirect <$> Annex.getConfig
+isDirect = annexDirect <$> Annex.getGitConfig
setDirect :: Bool -> Annex ()
setDirect b = do
setConfig (annexConfig "direct") $ if b then "true" else "false"
- Annex.changeConfig $ \c -> c { annexDirect = b }
+ Annex.changeGitConfig $ \c -> c { annexDirect = b }
{- Gets the http headers to use. -}
getHttpHeaders :: Annex [String]
getHttpHeaders = do
- v <- annexHttpHeadersCommand <$> Annex.getConfig
+ v <- annexHttpHeadersCommand <$> Annex.getGitConfig
case v of
Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
- Nothing -> annexHttpHeaders <$> Annex.getConfig
+ Nothing -> annexHttpHeaders <$> Annex.getGitConfig