From b8ba60428a0b4c077482560757e830e9ba02a823 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 14 Oct 2010 19:36:11 -0400 Subject: changed key to include backend name --- Backend/File.hs | 6 +++--- BackendTypes.hs | 20 +++++++++++++++----- Commands.hs | 18 +++++++++--------- Core.hs | 6 +++--- Locations.hs | 19 ++++++++++--------- 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// + - /path/to/repo/.git/annex/, where is of the form + - - - - (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 -- cgit v1.2.3