Special remotes configured with autoenable=true will be automatically enabled when git-annex init is run.
This commit is contained in:
parent
3f47d1b351
commit
9cfb96c53d
12 changed files with 148 additions and 64 deletions
|
@ -11,7 +11,7 @@ import Common.Annex
|
|||
import Command
|
||||
import qualified Logs.Remote
|
||||
import qualified Types.Remote as R
|
||||
import qualified Command.InitRemote as InitRemote
|
||||
import qualified Annex.SpecialRemote
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
|
@ -26,21 +26,20 @@ seek = withWords start
|
|||
|
||||
start :: [String] -> CommandStart
|
||||
start [] = unknownNameError "Specify the name of the special remote to enable."
|
||||
start (name:ws) = go =<< InitRemote.findExisting name
|
||||
start (name:ws) = go =<< Annex.SpecialRemote.findExisting name
|
||||
where
|
||||
config = Logs.Remote.keyValToConfig ws
|
||||
|
||||
go Nothing = unknownNameError "Unknown special remote name."
|
||||
go (Just (u, c)) = do
|
||||
let fullconfig = config `M.union` c
|
||||
t <- InitRemote.findType fullconfig
|
||||
|
||||
t <- either error return (Annex.SpecialRemote.findType fullconfig)
|
||||
showStart "enableremote" name
|
||||
next $ perform t u fullconfig
|
||||
|
||||
unknownNameError :: String -> Annex a
|
||||
unknownNameError prefix = do
|
||||
names <- InitRemote.remoteNames
|
||||
names <- Annex.SpecialRemote.remoteNames
|
||||
error $ prefix ++ "\n" ++
|
||||
if null names
|
||||
then "(No special remotes are currently known; perhaps use initremote instead?)"
|
||||
|
|
|
@ -10,6 +10,7 @@ module Command.Init where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import Annex.Init
|
||||
import qualified Annex.SpecialRemote
|
||||
|
||||
cmd :: Command
|
||||
cmd = dontCheck repoExists $
|
||||
|
@ -29,4 +30,5 @@ start ws = do
|
|||
perform :: String -> CommandPerform
|
||||
perform description = do
|
||||
initialize $ if null description then Nothing else Just description
|
||||
Annex.SpecialRemote.autoEnable
|
||||
next $ return True
|
||||
|
|
|
@ -10,14 +10,12 @@ module Command.InitRemote where
|
|||
import qualified Data.Map as M
|
||||
|
||||
import Common.Annex
|
||||
import Annex.SpecialRemote
|
||||
import Command
|
||||
import qualified Remote
|
||||
import qualified Logs.Remote
|
||||
import qualified Types.Remote as R
|
||||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
|
||||
import Data.Ord
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "initremote" SectionSetup
|
||||
|
@ -38,7 +36,7 @@ start (name:ws) = ifM (isJust <$> findExisting name)
|
|||
( error $ "There is already a remote named \"" ++ name ++ "\""
|
||||
, do
|
||||
let c = newConfig name
|
||||
t <- findType config
|
||||
t <- either error return (findType config)
|
||||
|
||||
showStart "initremote" name
|
||||
next $ perform t name $ M.union config c
|
||||
|
@ -57,47 +55,3 @@ cleanup u name c = do
|
|||
describeUUID u name
|
||||
Logs.Remote.configSet u c
|
||||
return True
|
||||
|
||||
{- See if there's an existing special remote with this name. -}
|
||||
findExisting :: String -> Annex (Maybe (UUID, R.RemoteConfig))
|
||||
findExisting name = do
|
||||
t <- trustMap
|
||||
matches <- sortBy (comparing $ \(u, _c) -> M.lookup u t )
|
||||
. findByName name
|
||||
<$> Logs.Remote.readRemoteLog
|
||||
return $ headMaybe matches
|
||||
|
||||
newConfig :: String -> R.RemoteConfig
|
||||
newConfig = M.singleton nameKey
|
||||
|
||||
findByName :: String -> M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
|
||||
findByName n = filter (matching . snd) . M.toList
|
||||
where
|
||||
matching c = case M.lookup nameKey c of
|
||||
Nothing -> False
|
||||
Just n'
|
||||
| n' == n -> True
|
||||
| otherwise -> False
|
||||
|
||||
remoteNames :: Annex [String]
|
||||
remoteNames = do
|
||||
m <- Logs.Remote.readRemoteLog
|
||||
return $ mapMaybe (M.lookup nameKey . snd) $ M.toList m
|
||||
|
||||
{- find the specified remote type -}
|
||||
findType :: R.RemoteConfig -> Annex RemoteType
|
||||
findType config = maybe unspecified specified $ M.lookup typeKey config
|
||||
where
|
||||
unspecified = error "Specify the type of remote with type="
|
||||
specified s = case filter (findtype s) Remote.remoteTypes of
|
||||
[] -> error $ "Unknown remote type " ++ s
|
||||
(t:_) -> return t
|
||||
findtype s i = R.typename i == s
|
||||
|
||||
{- The name of a configured remote is stored in its config using this key. -}
|
||||
nameKey :: String
|
||||
nameKey = "name"
|
||||
|
||||
{- The type of a remote is stored in its config using this key. -}
|
||||
typeKey :: String
|
||||
typeKey = "type"
|
||||
|
|
|
@ -13,6 +13,7 @@ import Annex.Init
|
|||
import Annex.UUID
|
||||
import Types.UUID
|
||||
import qualified Remote
|
||||
import qualified Annex.SpecialRemote
|
||||
|
||||
cmd :: Command
|
||||
cmd = dontCheck repoExists $
|
||||
|
@ -38,4 +39,5 @@ perform s = do
|
|||
else Remote.nameToUUID s
|
||||
storeUUID u
|
||||
initialize'
|
||||
Annex.SpecialRemote.autoEnable
|
||||
next $ return True
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue