implemented basic --drop

Backend.hs

@@ -14,9 +14,9 @@
  - -}
 
 module Backend (
-	storeFile,
+	storeFileKey,
-	dropFile,
+	removeKey,
-	retrieveFile,
+	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))
+storeFileKey :: FilePath -> Annex (Maybe (Key, Backend))
-storeFile file = do
+storeFileKey file = do
 	g <- Annex.gitRepo
 	let relfile = Git.relative g file
 	b <- Annex.backends
-	storeFile' b file relfile
+	storeFileKey' b file relfile
-storeFile' [] _ _ = return Nothing
+storeFileKey' [] _ _ = return Nothing
-storeFile' (b:bs) file relfile = do
+storeFileKey' (b:bs) file relfile = do
-	try <- (getKey b) relfile
+	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
+retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool
-retrieveFile backend key dest = (retrieveKeyFile backend) key dest
+retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest
 
-{- Drops a key from a backend. -}
+{- Removes a key from a backend. -}
-dropFile :: Backend -> Key -> Annex Bool
+removeKey :: Backend -> Key -> Annex Bool
-dropFile backend key = (removeKey backend)  key
+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. -}

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. -}

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

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 ()

Remotes.hs

@@ -45,8 +45,9 @@ withKey key = do
 				else return remotes'
 		err uuids = 
 			error $ "no available git remotes have: " ++
-			(keyFile key) ++ "\n" ++
+				(keyFile key) ++ (uuidlist uuids)
-			"It has been seen before in these repositories:\n" ++
+		uuidlist [] = ""
+		uuidlist uuids = "\nIt has been seen before in these repositories:\n" ++
 				prettyPrintUUIDs uuids
 
 {- Cost Ordered list of remotes. -}

TODO

@@ -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?