diff options
| -rw-r--r-- | Annex.hs | 30 | ||||
| -rw-r--r-- | Backend.hs | 23 | ||||
| -rw-r--r-- | BackendFile.hs | 10 | ||||
| -rw-r--r-- | BackendUrl.hs | 11 | ||||
| -rw-r--r-- | CmdLine.hs | 6 | ||||
| -rw-r--r-- | Types.hs | 6 | ||||
| -rw-r--r-- | git-annex.mdwn | 1 |
7 files changed, 65 insertions, 22 deletions
@@ -44,14 +44,30 @@ annexFile state file = do gitAdd (repo state) file checkExists file = do exists <- doesFileExist file - case (exists) of - False -> error $ "does not exist: " ++ file - True -> return () + if (not exists) + then error $ "does not exist: " ++ file + else return () checkLegal file = do - s <- getFileStatus file - case (not (isSymbolicLink s) && not (isRegularFile s)) of - False -> error $ "not a regular file: " ++ file - True -> return () + s <- getSymbolicLinkStatus file + if ((isSymbolicLink s) || (not $ isRegularFile s)) + then error $ "not a regular file: " ++ file + else return () + +{- Inverse of annexFile. -} +unannexFile :: State -> FilePath -> IO () +unannexFile state file = do + alreadyannexed <- lookupBackend (backends state) (repo state) file + case (alreadyannexed) of + Nothing -> error $ "not annexed " ++ file + Just _ -> do + mkey <- dropFile (backends state) (repo state) file + case (mkey) of + Nothing -> return () + Just key -> do + src <- annexDir (repo state) key + removeFile file + renameFile src file + return () {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () diff --git a/Backend.hs b/Backend.hs index 93ceee234..5ddd3aac6 100644 --- a/Backend.hs +++ b/Backend.hs @@ -57,14 +57,29 @@ storeFile (b:bs) repo file = do {- Attempts to retrieve an file from one of the backends, saving it to - a specified location. -} -retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool) +retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO Bool retrieveFile backends repo file dest = do result <- lookupBackend backends repo file case (result) of Nothing -> return False - Just b -> (retrieveKeyFile b) key dest - where - key = readFile (backendFile b repo file) + Just b -> do + key <- lookupKey b repo file + (retrieveKeyFile b) key dest + +{- Drops the key for a file from the backend that has it. -} +dropFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key) +dropFile backends repo file = do + result <- lookupBackend backends repo file + case (result) of + Nothing -> return Nothing + Just b -> do + key <- lookupKey b repo file + (removeKey b) key + return $ Just key + +{- Looks up the key a backend uses for an already annexed file. -} +lookupKey :: Backend -> GitRepo -> FilePath -> IO Key +lookupKey backend repo file = readFile (backendFile backend repo file) {- Looks up the backend used for an already annexed file. -} lookupBackend :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Backend) diff --git a/BackendFile.hs b/BackendFile.hs index deb4bce7e..de60803c3 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -9,7 +9,8 @@ backend = Backend { name = "file", getKey = keyValue, storeFileKey = dummyStore, - retrieveKeyFile = copyFromOtherRepo + retrieveKeyFile = copyFromOtherRepo, + removeKey = dummyRemove } -- direct mapping from filename to key @@ -18,11 +19,14 @@ keyValue repo file = return $ Just 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 a file is a no-op. -} + - and other accessible repos. So storing or removing a key is + - a no-op. -} dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) dummyStore repo file key = return True +dummyRemove :: Key -> IO Bool +dummyRemove url = return False {- Try to find a copy of the file in one of the other repos, - and copy it over to this one. -} -copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) +copyFromOtherRepo :: Key -> FilePath -> IO (Bool) copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/BackendUrl.hs b/BackendUrl.hs index 2bc34434b..ddeab9e04 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -9,16 +9,19 @@ backend = Backend { name = "url", getKey = keyValue, storeFileKey = dummyStore, - retrieveKeyFile = downloadUrl + retrieveKeyFile = downloadUrl, + removeKey = dummyRemove } -- cannot generate url from filename keyValue :: GitRepo -> FilePath -> IO (Maybe Key) keyValue repo file = return Nothing --- cannot store to urls -dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) +-- cannot change urls +dummyStore :: GitRepo -> FilePath -> Key -> IO Bool dummyStore repo file url = return False +dummyRemove :: Key -> IO Bool +dummyRemove url = return False -downloadUrl :: IO Key -> FilePath -> IO (Bool) +downloadUrl :: Key -> FilePath -> IO Bool downloadUrl url file = error "downloadUrl unimplemented" diff --git a/CmdLine.hs b/CmdLine.hs index d848ee8f9..3709f836b 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -10,8 +10,8 @@ import System.Console.GetOpt import Types import Annex -data Flag = Add FilePath | Push String | Pull String | - Want FilePath | Get (Maybe FilePath) | Drop FilePath +data Flag = Add FilePath | Push String | Pull String | Want FilePath | + Get (Maybe FilePath) | Drop FilePath | Unannex FilePath deriving Show options :: [OptDescr Flag] @@ -22,6 +22,7 @@ options = , Option ['w'] ["want"] (ReqArg Want "FILE") "request file contents" , Option ['g'] ["get"] (OptArg Get "FILE") "transfer file contents" , Option ['d'] ["drop"] (ReqArg Drop "FILE") "indicate file content not needed" + , Option ['u'] ["unannex"] (ReqArg Unannex "FILE") "undo --add" ] argvToFlags argv = do @@ -38,4 +39,5 @@ dispatch :: Flag -> State -> IO () dispatch flag state = do case (flag) of Add f -> annexFile state f + Unannex f -> unannexFile state f _ -> error "not implemented" @@ -13,9 +13,11 @@ data Backend = Backend { -- converts a filename to a key getKey :: GitRepo -> FilePath -> IO (Maybe Key), -- stores a file's contents to a key - storeFileKey :: GitRepo -> FilePath -> Key -> IO (Bool), + storeFileKey :: GitRepo -> FilePath -> Key -> IO Bool, -- retrieves a key's contents to a file - retrieveKeyFile :: IO Key -> FilePath -> IO (Bool) + retrieveKeyFile :: Key -> FilePath -> IO Bool, + -- removes a key + removeKey :: Key -> IO Bool } -- a git repository diff --git a/git-annex.mdwn b/git-annex.mdwn index bc3550398..2996a90b5 100644 --- a/git-annex.mdwn +++ b/git-annex.mdwn @@ -36,6 +36,7 @@ Enough broad picture, here's how it actually looks: downloaded. * `git annex --drop $file` indicates that you no longer want the file's content to be available in this repository. +* `git annex --unannex $file` undoes a `git annex --add`. * `git annex $file` is a shorthand for either --add or --get. If the file is already known, it does --get, otherwise it does --add. |