diff options
-rw-r--r-- | Backend.hs | 34 | ||||
-rw-r--r-- | Backend/File.hs | 6 | ||||
-rw-r--r-- | Backend/Url.hs | 4 | ||||
-rw-r--r-- | Commands.hs | 24 | ||||
-rw-r--r-- | Remotes.hs | 7 | ||||
-rw-r--r-- | TODO | 2 |
6 files changed, 49 insertions, 28 deletions
diff --git a/Backend.hs b/Backend.hs index 2829fef9d..7a8a41a4b 100644 --- a/Backend.hs +++ b/Backend.hs @@ -14,9 +14,9 @@ - -} module Backend ( - storeFile, - dropFile, - retrieveFile, + storeFileKey, + removeKey, + retrieveKeyFile, lookupFile ) where @@ -32,37 +32,37 @@ import qualified GitRepo as Git import qualified Annex import Utility import Types -import BackendTypes +import qualified BackendTypes as B {- Attempts to store a file in one of the backends. -} -storeFile :: FilePath -> Annex (Maybe (Key, Backend)) -storeFile file = do +storeFileKey :: FilePath -> Annex (Maybe (Key, Backend)) +storeFileKey file = do g <- Annex.gitRepo let relfile = Git.relative g file b <- Annex.backends - storeFile' b file relfile -storeFile' [] _ _ = return Nothing -storeFile' (b:bs) file relfile = do - try <- (getKey b) relfile + storeFileKey' b file relfile +storeFileKey' [] _ _ = return Nothing +storeFileKey' (b:bs) file relfile = do + try <- (B.getKey b) relfile case (try) of Nothing -> nextbackend Just key -> do - stored <- (storeFileKey b) file key + stored <- (B.storeFileKey b) file key if (not stored) then nextbackend else do return $ Just (key, b) where - nextbackend = storeFile' bs file relfile + nextbackend = storeFileKey' bs file relfile {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: Backend -> Key -> FilePath -> Annex Bool -retrieveFile backend key dest = (retrieveKeyFile backend) key dest +retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool +retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest -{- Drops a key from a backend. -} -dropFile :: Backend -> Key -> Annex Bool -dropFile backend key = (removeKey backend) key +{- Removes a key from a backend. -} +removeKey :: Backend -> Key -> Annex Bool +removeKey backend key = (B.removeKey backend) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} diff --git a/Backend/File.hs b/Backend/File.hs index 2ac12487e..311fe820b 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -28,13 +28,15 @@ keyValue file = return $ Just $ Key file {- This backend does not really do any independant data storage, - it relies on the file contents in .git/annex/ in this repo, - - and other accessible repos. So storing or removing a key is + - and other accessible repos. So storing a key is - a no-op. TODO until support is added for git annex --push otherrepo, - then these could implement that.. -} dummyStore :: FilePath -> Key -> Annex (Bool) dummyStore file key = return True + +{- Allow keys to be removed. -} dummyRemove :: Key -> Annex Bool -dummyRemove url = return False +dummyRemove url = return True {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} diff --git a/Backend/Url.hs b/Backend/Url.hs index 9831c337b..3d971864a 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -23,8 +23,10 @@ keyValue file = return Nothing -- cannot change url contents dummyStore :: FilePath -> Key -> Annex Bool dummyStore file url = return False + +-- allow keys to be removed dummyRemove :: Key -> Annex Bool -dummyRemove url = return False +dummyRemove url = return True downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl url file = do diff --git a/Commands.hs b/Commands.hs index b4f57d6fe..65f6f6efd 100644 --- a/Commands.hs +++ b/Commands.hs @@ -40,7 +40,7 @@ defaultCmd file = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file - stored <- Backend.storeFile file + stored <- Backend.storeFileKey file g <- Annex.gitRepo case (stored) of Nothing -> error $ "no backend could store: " ++ file @@ -76,7 +76,7 @@ addCmd file = inBackend file err $ do {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () unannexCmd file = notinBackend file err $ \(key, backend) -> do - Backend.dropFile backend key + Backend.removeKey backend key logStatus key ValueMissing g <- Annex.gitRepo let src = annexLocation g backend key @@ -104,7 +104,7 @@ getCmd file = notinBackend file err $ \(key, backend) -> do g <- Annex.gitRepo let dest = annexLocation g backend key liftIO $ createDirectoryIfMissing True (parentDir dest) - success <- Backend.retrieveFile backend key dest + success <- Backend.retrieveKeyFile backend key dest if (success) then do logStatus key ValuePresent @@ -119,7 +119,23 @@ wantCmd file = do error "not implemented" -- TODO {- Indicates a file is not wanted. -} dropCmd :: FilePath -> Annex () -dropCmd file = do error "not implemented" -- TODO +dropCmd file = notinBackend file err $ \(key, backend) -> do + -- TODO only remove if enough copies are present elsewhere + success <- Backend.removeKey backend key + if (success) + then do + logStatus key ValueMissing + inannex <- inAnnex backend key + if (inannex) + then do + g <- Annex.gitRepo + let loc = annexLocation g backend key + liftIO $ removeFile loc + return () + else return () + else error $ "backend refused to drop " ++ file + where + err = error $ "not annexed " ++ file {- Pushes all files to a remote repository. -} pushCmd :: String -> Annex () diff --git a/Remotes.hs b/Remotes.hs index 4f4e5a26c..f20d51ab3 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -45,9 +45,10 @@ withKey key = do else return remotes' err uuids = error $ "no available git remotes have: " ++ - (keyFile key) ++ "\n" ++ - "It has been seen before in these repositories:\n" ++ - prettyPrintUUIDs uuids + (keyFile key) ++ (uuidlist uuids) + uuidlist [] = "" + uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++ + prettyPrintUUIDs uuids {- Cost Ordered list of remotes. -} remotesByCost :: Annex [Git.Repo] @@ -1,7 +1,7 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* --push/--pull/--want/--drop +* --push/--pull/--want * how to handle git mv file? |