aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command.hs2
-rw-r--r--Command/Describe.hs41
-rw-r--r--Command/Init.hs2
-rw-r--r--GitAnnex.hs2
-rw-r--r--Remotes.hs12
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