diff options
| -rw-r--r-- | Annex.hs | 34 | ||||
| -rw-r--r-- | Backend.hs | 67 |
2 files changed, 34 insertions, 67 deletions
@@ -45,10 +45,9 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - -- TODO check if already annexed - let alreadyannexed = Nothing - case (alreadyannexed) of - Just _ -> error $ "already annexed: " ++ file + r <- lookupFile file + case (r) of + Just _ -> error $ "already annexed " ++ file Nothing -> do checkLegal file stored <- storeFile state file @@ -84,16 +83,14 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - -- TODO check if already annexed - let alreadyannexed = Just 1 - case (alreadyannexed) of + r <- lookupFile file + case (r) of Nothing -> error $ "not annexed " ++ file - Just _ -> do - key <- fileKey file - dropped <- dropFile state key - case (dropped) of - Nothing -> return () - Just (key, backend) -> do + Just (key, backend) -> do + dropped <- dropFile state backend key + if (not dropped) + then error $ "backend refused to drop " ++ file + else do let src = annexLocation state backend key removeFile file gitRun (repo state) ["rm", file] @@ -110,20 +107,17 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - -- TODO check if already annexed - let alreadyannexed = Just 1 - case (alreadyannexed) of + r <- lookupFile file + case (r) of Nothing -> error $ "not annexed " ++ file - Just _ -> do - key <- fileKey file - backend <- fileBackend file + Just (key, backend) -> do inannex <- inAnnex state backend key if (inannex) then return () else do let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state key dest + success <- retrieveFile state backend key dest if (success) then do logStatus state key ValuePresent diff --git a/Backend.hs b/Backend.hs index dbb0064a5..2697f43d4 100644 --- a/Backend.hs +++ b/Backend.hs @@ -14,14 +14,13 @@ - -} module Backend ( - lookupBackend, storeFile, dropFile, retrieveFile, - fileKey, - fileBackend + lookupFile ) where +import Control.Exception import System.Directory import System.FilePath import Data.String.Utils @@ -51,50 +50,24 @@ storeFile' (b:bs) state file = do {- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: State -> Key -> FilePath -> IO Bool -retrieveFile state key dest = do - result <- lookupBackend state key - case (result) of - Nothing -> return False - Just backend -> (retrieveKeyFile backend) state key dest - -{- Drops a key from the backend that has it. -} -dropFile :: State -> Key -> IO (Maybe (Key, Backend)) -dropFile state key = do - result <- lookupBackend state key - case (result) of - Nothing -> return Nothing - Just backend -> do - (removeKey backend) state key - return $ Just (key, backend) - -{- Looks up the backend that has a key. -} -lookupBackend :: State -> Key -> IO (Maybe Backend) -lookupBackend state key = lookupBackend' (backends state) state key -lookupBackend' [] _ _ = return Nothing -lookupBackend' (b:bs) state key = do - present <- checkBackend b state key - if present - then - return $ Just b - else - lookupBackend' bs state key +retrieveFile :: State -> Backend -> Key -> FilePath -> IO Bool +retrieveFile state backend key dest = (retrieveKeyFile backend) state key dest -{- Checks if a key is available via a given backend. -} -checkBackend :: Backend -> State -> Key -> IO (Bool) -checkBackend backend state key = - doesFileExist $ annexLocation state backend key +{- Drops a key from a backend. -} +dropFile :: State -> Backend -> Key -> IO Bool +dropFile state backend key = (removeKey backend) state key -{- Looks up the key corresponding to an annexed file, +{- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} -fileKey :: FilePath -> IO Key -fileKey file = do - l <- readSymbolicLink (file) - return $ Key $ takeFileName $ l - -{- Looks up the backend corresponding to an annexed file, - - by examining what the file symlinks to. -} -fileBackend :: FilePath -> IO Backend -fileBackend file = do - l <- readSymbolicLink (file) - return $ lookupBackendName $ takeFileName $ parentDir $ l +lookupFile :: FilePath -> IO (Maybe (Key, Backend)) +lookupFile file = do + result <- try (lookup)::IO (Either SomeException (Maybe (Key, Backend))) + case (result) of + Left err -> return Nothing + Right succ -> return succ + where + lookup = do + l <- readSymbolicLink file + return $ Just (k l, b l) + k l = Key $ takeFileName $ l + b l = lookupBackendName $ takeFileName $ parentDir $ l |