add describe subcommand

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