summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 19:36:11 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 19:36:11 -0400
commitb8ba60428a0b4c077482560757e830e9ba02a823 (patch)
tree68c247edd2570d9121c150b35838f114eb9f994e
parentc4959fee47f168857998dea6d11395158251158d (diff)
changed key to include backend name
-rw-r--r--Backend/File.hs6
-rw-r--r--BackendTypes.hs20
-rw-r--r--Commands.hs18
-rw-r--r--Core.hs6
-rw-r--r--Locations.hs19
5 files changed, 40 insertions, 29 deletions
diff --git a/Backend/File.hs b/Backend/File.hs
index def2f3091..6267b478a 100644
--- a/Backend/File.hs
+++ b/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
diff --git a/BackendTypes.hs b/BackendTypes.hs
index e480f725b..e0f5f7373 100644
--- a/BackendTypes.hs
+++ b/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 {
diff --git a/Commands.hs b/Commands.hs
index ce8f00fd6..7ff33ab02 100644
--- a/Commands.hs
+++ b/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 ()
diff --git a/Core.hs b/Core.hs
index 5182a6855..6f05394bb 100644
--- a/Core.hs
+++ b/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
diff --git a/Locations.hs b/Locations.hs
index 7b8beb14f..960a8938d 100644
--- a/Locations.hs
+++ b/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