git annex describe

5 files changed, 30 insertions, 16 deletions

diff --git a/Backend.hs b/Backend.hs
index f419831d2..636557d7d 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,7 +1,7 @@
-{- git-annex key/value storage backends
+{- git-annex key-value storage backends
  -
- - git-annex uses a key/value abstraction layer to allow files contents to be
- - stored in different ways. In theory, any key/value storage system could be
+ - git-annex uses a key-value abstraction layer to allow files contents to be
+ - stored in different ways. In theory, any key-value storage system could be
  - used to store the file contents, and git-annex would then retrieve them
  - as needed and put them in `.git/annex/`.
  - 
diff --git a/Backend/File.hs b/Backend/File.hs
index b2c5c90eb..c443b4f7a 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -58,7 +58,7 @@ copyKeyFile key file = do
 		else return ()
 	trycopy remotes remotes
 	where
-		trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++
+		trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++
 			"To get that file, need access to one of these remotes: " ++
 			(Remotes.list full)
 		trycopy full (r:rs) = do
@@ -79,7 +79,7 @@ copyKeyFile key file = do
 			g <- Annex.gitRepo
 			uuids <- liftIO $ keyLocations g key
 			ppuuids <- prettyPrintUUIDs uuids
-			error $ "no available git remotes have: " ++
+			error $ "no available git remotes have file with key: " ++
 				(keyFile key) ++ 
 				if (0 < length uuids)
 					then "\nIt has been seen before in these repositories:\n" ++ ppuuids
diff --git a/BackendTypes.hs b/BackendTypes.hs
index 13ffde7f8..41bc77858 100644
--- a/BackendTypes.hs
+++ b/BackendTypes.hs
@@ -49,7 +49,7 @@ backendName (Key (b,k)) = b
 keyFrag :: Key -> KeyFrag
 keyFrag (Key (b,k)) = k
 
--- this structure represents a key/value backend
+-- this structure represents a key-value backend
 data Backend = Backend {
 	-- name of this backend
 	name :: String,
diff --git a/Commands.hs b/Commands.hs
index 11f808c21..1f9128011 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -23,7 +23,7 @@ import Core
 import qualified Remotes
 import qualified BackendTypes
 
-data CmdWants = FilesInGit | FilesNotInGit | RepoName
+data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString
 data Command = Command {
 	cmdname :: String,
 	cmdaction :: (String -> Annex ()),
@@ -34,10 +34,10 @@ cmds :: [Command]
 cmds =  [ (Command "add"	addCmd		FilesNotInGit)
 	, (Command "get"	getCmd		FilesInGit)
 	, (Command "drop"	dropCmd		FilesInGit)
-	, (Command "want"	wantCmd		FilesInGit)
 	, (Command "push"	pushCmd		RepoName)
 	, (Command "pull"	pullCmd		RepoName)
 	, (Command "unannex"	unannexCmd	FilesInGit)
+	, (Command "describe"	describeCmd	SingleString)
 	]
 
 {- Finds the type of parameters a command wants, from among the passed
@@ -49,6 +49,8 @@ findWanted FilesNotInGit params repo = do
 findWanted FilesInGit params repo = do
 	files <- mapM (Git.inRepo repo) params
 	return $ foldl (++) [] files
+findWanted SingleString params _ = do
+	return $ [unwords params]
 findWanted RepoName params _ = do
 	return $ params
 
@@ -150,11 +152,8 @@ getCmd file = notinBackend file err $ \(key, backend) -> do
 	where
 		err = error $ "not annexed " ++ file
 
-{- Indicates a file is wanted. -}
-wantCmd :: FilePath -> Annex ()
-wantCmd file = do error "not implemented" -- TODO
-
-{- Indicates a file is not wanted. -}
+{- Indicates a file's content is not wanted anymore, and should be removed
+ - if it's safe to do so. -}
 dropCmd :: FilePath -> Annex ()
 dropCmd file = notinBackend file err $ \(key, backend) -> do
 	force <- Annex.flagIsSet Force
@@ -185,6 +184,17 @@ pushCmd reponame = do error "not implemented" -- TODO
 pullCmd :: String -> Annex ()
 pullCmd reponame = do error "not implemented" -- TODO
 
+{- Stores description for the repository. -}
+describeCmd :: String -> Annex ()
+describeCmd description = do
+	g <- Annex.gitRepo
+	u <- getUUID g
+	describeUUID u description
+	log <- uuidLog
+	liftIO $ Git.run g ["add", log]
+	Annex.flagChange NeedCommit True
+	liftIO $ putStrLn "description set"
+
 {- Updates the LocationLog when a key's presence changes. -}
 logStatus :: Key -> LogStatus -> Annex ()
 logStatus key status = do
diff --git a/UUID.hs b/UUID.hs
index 8cdee43de..3e6991d48 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -12,7 +12,8 @@ module UUID (
 	genUUID,
 	reposByUUID,
 	prettyPrintUUIDs,
-	describeUUID
+	describeUUID,
+	uuidLog
 ) where
 
 import Control.Monad.State
@@ -25,6 +26,7 @@ import qualified GitRepo as Git
 import Types
 import Locations
 import qualified Annex
+import Utility
 
 type UUID = String
 
@@ -110,7 +112,7 @@ describeUUID uuid desc = do
 	m <- uuidMap
 	let m' = M.insert uuid desc m
 	log <- uuidLog
-	liftIO $ writeFile log $ serialize m'
+	liftIO $ withFileLocked log WriteMode (\h -> hPutStr h $ serialize m')
 	where
 		serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
 
@@ -118,7 +120,9 @@ describeUUID uuid desc = do
 uuidMap :: Annex (M.Map UUID String)
 uuidMap = do
 	log <- uuidLog
-	s <- liftIO $ catch (readFile log) (\error -> return "")
+	s <- liftIO $ catch
+		(withFileLocked log ReadMode $ \h -> hGetContentsStrict h)
+		(\error -> return "")
 	return $ M.fromList $ map (\l -> pair l) $ lines s
 	where
 		pair l =