diff options
| -rw-r--r-- | Command.hs | 2 | ||||
| -rw-r--r-- | Command/Describe.hs | 41 | ||||
| -rw-r--r-- | Command/Init.hs | 2 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Remotes.hs | 12 |
5 files changed, 55 insertions, 4 deletions
diff --git a/Command.hs b/Command.hs index d54a7052e..09adc0949 100644 --- a/Command.hs +++ b/Command.hs @@ -209,6 +209,8 @@ paramRepeating :: String -> String paramRepeating s = s ++ " ..." paramOptional :: String -> String paramOptional s = "[" ++ s ++ "]" +paramPair :: String -> String -> String +paramPair a b = a ++ " " ++ b paramPath :: String paramPath = "PATH" paramKey :: String diff --git a/Command/Describe.hs b/Command/Describe.hs new file mode 100644 index 000000000..643ca0471 --- /dev/null +++ b/Command/Describe.hs @@ -0,0 +1,41 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Describe where + + +import Command +import qualified GitRepo as Git +import qualified Remotes +import UUID +import Messages +import qualified Command.Init + +command :: [Command] +command = [Command "describe" (paramPair paramRemote paramDesc) seek + "change description of a repository"] + +seek :: [CommandSeek] +seek = [withString start] + +start :: CommandStartString +start params = notBareRepo $ do + let (name, description) = + case (words params) of + (n:d) -> (n,unwords d) + _ -> error "Specify a repository and a description." + + showStart "describe" name + Remotes.readConfigs + r <- Remotes.byName name + return $ Just $ perform r description + +perform :: Git.Repo -> String -> CommandPerform +perform repo description = do + u <- getUUID repo + describeUUID u description + return $ Just $ Command.Init.cleanup diff --git a/Command/Init.hs b/Command/Init.hs index 509c9e51c..2c5fdc2fc 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -62,7 +62,7 @@ cleanup = do liftIO $ Git.run g "add" [File logfile] liftIO $ Git.run g "commit" [ Params "-q -m" - , Param "git annex init" + , Param "git annex repository description" , File logfile ] return True diff --git a/GitAnnex.hs b/GitAnnex.hs index 3be222874..b26714a59 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -26,6 +26,7 @@ import qualified Command.DropKey import qualified Command.SetKey import qualified Command.Fix import qualified Command.Init +import qualified Command.Describe import qualified Command.Fsck import qualified Command.Unused import qualified Command.DropUnused @@ -50,6 +51,7 @@ cmds = concat , Command.Unlock.command , Command.Lock.command , Command.Init.command + , Command.Describe.command , Command.Unannex.command , Command.Uninit.command , Command.PreCommit.command diff --git a/Remotes.hs b/Remotes.hs index 4dcc4c9ad..a7d6be67d 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -211,17 +211,23 @@ repoNotIgnored r = do same :: Git.Repo -> Git.Repo -> Bool same a b = Git.repoRemoteName a == Git.repoRemoteName b -{- Looks up a remote by name. -} +{- Looks up a remote by name. (Or by UUID.) -} byName :: String -> Annex Git.Repo byName "." = Annex.gitRepo -- special case to refer to current repository byName name = do when (null name) $ error "no remote specified" g <- Annex.gitRepo - let match = filter (\r -> Just name == Git.repoRemoteName r) $ - Git.remotes g + match <- filterM matching $ Git.remotes g when (null match) $ error $ "there is no git remote named \"" ++ name ++ "\"" return $ head match + where + matching r = do + if Just name == Git.repoRemoteName r + then return True + else do + u <- getUUID r + return $ (name == u) {- Tries to copy a key's content from a remote's annex to a file. -} copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool |