mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor

Browse source
This commit is contained in:
Joey Hess 2015-08-17 11:21:13 -04:00
parent 1cd3b7ddf0
commit fb9d851258
2 changed files with 17 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Config.hs
View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Config where module Config where
import Common.Annex import Common.Annex
@ -14,6 +16,7 @@ import qualified Git.Command
import qualified Annex import qualified Annex
import Config.Cost import Config.Cost
import Types.Availability import Types.Availability
import Git.Types
type UnqualifiedConfigKey = String type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String data ConfigKey = ConfigKey String
@ -41,10 +44,19 @@ reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead
unsetConfig :: ConfigKey -> Annex () unsetConfig :: ConfigKey -> Annex ()
unsetConfig (ConfigKey key) = void $ inRepo $ Git.Config.unset key unsetConfig (ConfigKey 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
{- A per-remote config setting in git config. -} {- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $ remoteConfig r key = ConfigKey $
"remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key "remote." ++ getRemoteName r ++ ".annex-" ++ key
{- A global annex setting in git config. -} {- A global annex setting in git config. -}
annexConfig :: UnqualifiedConfigKey -> ConfigKey annexConfig :: UnqualifiedConfigKey -> ConfigKey

9
Remote/Helper/Special.hs
View file

@ -36,6 +36,7 @@ import Common.Annex
import Types.StoreRetrieve import Types.StoreRetrieve
import Types.Remote import Types.Remote
import Crypto import Crypto
import Config
import Config.Cost import Config.Cost
import Utility.Metered import Utility.Metered
import Remote.Helper.Chunked as X import Remote.Helper.Chunked as X
@ -44,7 +45,6 @@ import Remote.Helper.Messages
import Annex.Content import Annex.Content
import Messages.Progress import Messages.Progress
import qualified Git import qualified Git
import qualified Git.Command
import qualified Git.Construct import qualified Git.Construct
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -66,13 +66,10 @@ findSpecialRemotes s = do
{- Sets up configuration for a special remote in .git/config. -} {- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex ()
gitConfigSpecialRemote u c k v = do gitConfigSpecialRemote u c k v = do
set ("annex-"++k) v setConfig (remoteConfig remotename k) v
set ("annex-uuid") (fromUUID u) setConfig (remoteConfig remotename "uuid") (fromUUID u)
where where
set a b = inRepo $ Git.Command.run
[Param "config", Param (configsetting a), Param b]
remotename = fromJust (M.lookup "name" c) remotename = fromJust (M.lookup "name" c)
configsetting s = "remote." ++ remotename ++ "." ++ s
-- Use when nothing needs to be done to prepare a helper. -- Use when nothing needs to be done to prepare a helper.
simplyPrepare :: helper -> Preparer helper simplyPrepare :: helper -> Preparer helper