changed key to include backend name

Backend/File.hs

@@ -29,7 +29,7 @@ backend = Backend {
 
 -- direct mapping from filename to key
 keyValue :: FilePath -> Annex (Maybe Key)
-keyValue file = return $ Just $ Key file
+keyValue file = return $ Just $ Key ((name backend), file)
 
 {- This backend does not really do any independant data storage,
  - it relies on the file contents in .git/annex/ in this repo,
@@ -44,7 +44,7 @@ dummyRemove url = return True
 
 {- Just check if the .git/annex/ file for the key exists. -}
 checkKeyFile :: Key -> Annex Bool
-checkKeyFile k = inAnnex backend k
+checkKeyFile k = inAnnex k
 
 {- Try to find a copy of the file in one of the remotes,
  - and copy it over to this one. -}
@@ -97,4 +97,4 @@ copyFromRemote r key file = do
 				then return ()
 				else error "cp failed"
 		getremote = error "get via network not yet implemented!"
-		location = annexLocation r backend key
+		location = annexLocation r key

BackendTypes.hs

@@ -5,7 +5,7 @@
 
 module BackendTypes where
 
-import Control.Monad.State
+import Control.Monad.State (StateT)
 import Data.String.Utils
 import qualified GitRepo as Git
 
@@ -19,12 +19,22 @@ data AnnexState = AnnexState {
 -- git-annex's monad
 type Annex = StateT AnnexState IO
 
--- annexed filenames are mapped into keys
-data Key = Key String deriving (Eq)
+-- annexed filenames are mapped through a backend into keys
+type KeyFrag = String
+type BackendName = String
+data Key = Key (BackendName, KeyFrag) deriving (Eq)
 
--- show a key to convert it to a string
+-- show a key to convert it to a string; the string includes the
+-- name of the backend to avoid collisions between key strings
 instance Show Key where
-	show (Key v) = v
+	show (Key (b, k)) = b ++ ":" ++ k
+
+instance Read Key where
+	readsPrec _ s = [((Key (b,k)) ,"")]
+		where
+			l = split ":" s
+			b = l !! 0
+			k = join ":" $ drop 1 l
 
 -- this structure represents a key/value backend
 data Backend = Backend {

Commands.hs

@@ -66,7 +66,7 @@ addCmd file = inBackend file err $ do
 		Nothing -> error $ "no backend could store: " ++ file
 		Just (key, backend) -> do
 			logStatus key ValuePresent
-			liftIO $ setup g key backend
+			liftIO $ setup g key
 	where
 		err = error $ "already annexed " ++ file
 		checkLegal file = do
@@ -74,9 +74,9 @@ addCmd file = inBackend file err $ do
 			if ((isSymbolicLink s) || (not $ isRegularFile s))
 				then error $ "not a regular file: " ++ file
 				else return ()
-		setup g key backend = do
-			let dest = annexLocation g backend key
-			let reldest = annexLocationRelative g backend key
+		setup g key = do
+			let dest = annexLocation g key
+			let reldest = annexLocationRelative g key
 			createDirectoryIfMissing True (parentDir dest)
 			renameFile file dest
 			createSymbolicLink ((linkTarget file) ++ reldest) file
@@ -99,7 +99,7 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do
 	Backend.removeKey backend key
 	logStatus key ValueMissing
 	g <- Annex.gitRepo
-	let src = annexLocation g backend key
+	let src = annexLocation g key
 	liftIO $ moveout g src
 	where
 		err = error $ "not annexed " ++ file
@@ -117,12 +117,12 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do
 {- Gets an annexed file from one of the backends. -}
 getCmd :: FilePath -> Annex ()
 getCmd file = notinBackend file err $ \(key, backend) -> do
-	inannex <- inAnnex backend key
+	inannex <- inAnnex key
 	if (inannex)
 		then return ()
 		else do
 			g <- Annex.gitRepo
-			let dest = annexLocation g backend key
+			let dest = annexLocation g key
 			liftIO $ createDirectoryIfMissing True (parentDir dest)
 			success <- Backend.retrieveKeyFile backend key dest
 			if (success)
@@ -145,11 +145,11 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do
 	if (success)
 		then do
 			logStatus key ValueMissing
-			inannex <- inAnnex backend key
+			inannex <- inAnnex key
 			if (inannex)
 				then do
 					g <- Annex.gitRepo
-					let loc = annexLocation g backend key
+					let loc = annexLocation g key
 					liftIO $ removeFile loc
 					return ()
 				else return ()

Core.hs

@@ -50,7 +50,7 @@ gitAttributes repo = do
 					attributes]
 
 {- Checks if a given key is currently present in the annexLocation -}
-inAnnex :: Backend -> Key -> Annex Bool
-inAnnex backend key = do
+inAnnex :: Key -> Annex Bool
+inAnnex key = do
 	g <- Annex.gitRepo
-	liftIO $ doesFileExist $ annexLocation g backend key
+	liftIO $ doesFileExist $ annexLocation g key

Locations.hs

@@ -22,18 +22,19 @@ gitStateDir :: Git.Repo -> FilePath
 gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc ++ "/"
 
 {- An annexed file's content is stored in 
- - /path/to/repo/.git/annex/<backend>/<key>
+ - /path/to/repo/.git/annex/<key>, where <key> is of the form
+ - <backend:fragment>
  -
- - (That allows deriving the key and backend by looking at the symlink to it.)
+ - That allows deriving the key and backend by looking at the symlink to it.
  -}
-annexLocation :: Git.Repo -> Backend -> Key -> FilePath
-annexLocation r backend key = 
-	(Git.workTree r) ++ "/" ++ (annexLocationRelative r backend key)
+annexLocation :: Git.Repo -> Key -> FilePath
+annexLocation r key = 
+	(Git.workTree r) ++ "/" ++ (annexLocationRelative r key)
 
 {- Annexed file's location relative to the gitWorkTree -}
-annexLocationRelative :: Git.Repo -> Backend -> Key -> FilePath
-annexLocationRelative r backend key = 
-	Git.dir r ++ "/annex/" ++ (Backend.name backend) ++ "/" ++ (keyFile key)
+annexLocationRelative :: Git.Repo -> Key -> FilePath
+annexLocationRelative r key = 
+	Git.dir r ++ "/annex/" ++ (keyFile key)
 
 {- Converts a key into a filename fragment.
  -
@@ -51,5 +52,5 @@ keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key
 {- Reverses keyFile, converting a filename fragment (ie, the basename of
  - the symlink target) into a key. -}
 fileKey :: FilePath -> Key
-fileKey file = Backend.Key $ 
+fileKey file = read $
 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file