diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-13 02:31:24 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-13 02:31:24 -0400 |
commit | d1071bd1fe879abb3ebb229f9347f7855a697b8c (patch) | |
tree | db9df662b58f2b0762252f4d22b5cb244c8be978 | |
parent | 490a3a828cbb5a4046178b36fc0f9fe0696d0e9d (diff) |
autobugfixing!
Converted Key to a real data type and caught all the places where I used
an unconverted filename as a key.
Had to loose some sanity checks around whether something is already
annexed, but I guess I can add those back other ways.
-rw-r--r-- | Annex.hs | 21 | ||||
-rw-r--r-- | Backend.hs | 54 | ||||
-rw-r--r-- | BackendFile.hs | 5 | ||||
-rw-r--r-- | BackendUrl.hs | 4 | ||||
-rw-r--r-- | Locations.hs | 2 | ||||
-rw-r--r-- | Types.hs | 6 |
6 files changed, 54 insertions, 38 deletions
@@ -45,7 +45,8 @@ startAnnex = do - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Nothing case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do @@ -83,15 +84,17 @@ annexFile state file = do {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Just 1 case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile state file - case (mkey) of + key <- fileKey file + dropped <- dropFile state key + case (dropped) of Nothing -> return () Just (key, backend) -> do - let src = annexLocation state backend file + let src = annexLocation state backend key removeFile file gitRun (repo state) ["rm", file] gitRun (repo state) ["commit", "-m", @@ -107,18 +110,20 @@ unannexFile state file = do {- Transfers the file from a remote. -} annexGetFile :: State -> FilePath -> IO () annexGetFile state file = do - alreadyannexed <- lookupBackend state file + -- TODO check if already annexed + let alreadyannexed = Just 1 case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file - Just backend -> do + Just _ -> do key <- fileKey file + backend <- fileBackend file inannex <- inAnnex state backend key if (inannex) then return () else do let dest = annexLocation state backend key createDirectoryIfMissing True (parentDir dest) - success <- retrieveFile state file dest + success <- retrieveFile state key dest if (success) then do logStatus state key ValuePresent diff --git a/Backend.hs b/Backend.hs index 68d70feec..dbb0064a5 100644 --- a/Backend.hs +++ b/Backend.hs @@ -16,15 +16,17 @@ module Backend ( lookupBackend, storeFile, + dropFile, retrieveFile, fileKey, - dropFile + fileBackend ) where import System.Directory import System.FilePath import Data.String.Utils import System.Posix.Files +import BackendList import Locations import GitRepo import Utility @@ -47,48 +49,52 @@ storeFile' (b:bs) state file = do where nextbackend = storeFile' bs state file -{- Attempts to retrieve an file from one of the backends, saving it to +{- Attempts to retrieve an key from one of the backends, saving it to - a specified location. -} -retrieveFile :: State -> FilePath -> FilePath -> IO Bool -retrieveFile state file dest = do - result <- lookupBackend state file +retrieveFile :: State -> Key -> FilePath -> IO Bool +retrieveFile state key dest = do + result <- lookupBackend state key case (result) of Nothing -> return False - Just backend -> do - key <- fileKey file - (retrieveKeyFile backend) state key dest + Just backend -> (retrieveKeyFile backend) state key dest -{- Drops the key for a file from the backend that has it. -} -dropFile :: State -> FilePath -> IO (Maybe (Key, Backend)) -dropFile state file = do - result <- lookupBackend state file +{- 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 - key <- fileKey file (removeKey backend) state key return $ Just (key, backend) -{- Looks up the backend used for an already annexed file. -} -lookupBackend :: State -> FilePath -> IO (Maybe Backend) -lookupBackend state file = lookupBackend' (backends state) state file +{- 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 file = do - present <- checkBackend b state file +lookupBackend' (b:bs) state key = do + present <- checkBackend b state key if present then return $ Just b else - lookupBackend' bs state file + lookupBackend' bs state key -{- Checks if a file is available via a given backend. -} -checkBackend :: Backend -> State -> FilePath -> IO (Bool) -checkBackend backend state file = - doesFileExist $ annexLocation state backend file +{- 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 {- Looks up the key corresponding to an annexed file, - by examining what the file symlinks to. -} fileKey :: FilePath -> IO Key fileKey file = do l <- readSymbolicLink (file) - return $ takeFileName $ l + 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 diff --git a/BackendFile.hs b/BackendFile.hs index 43ca2191c..15b23536b 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -15,12 +15,13 @@ backend = Backend { -- direct mapping from filename to key keyValue :: State -> FilePath -> IO (Maybe Key) -keyValue state file = return $ Just file +keyValue state 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 - - a no-op. -} + - a no-op. TODO until support is added for git annex --push otherrepo, + - then these could implement that.. -} dummyStore :: State -> FilePath -> Key -> IO (Bool) dummyStore state file key = return True dummyRemove :: State -> Key -> IO Bool diff --git a/BackendUrl.hs b/BackendUrl.hs index 3f0846885..5b586497c 100644 --- a/BackendUrl.hs +++ b/BackendUrl.hs @@ -27,8 +27,8 @@ dummyRemove state url = return False downloadUrl :: State -> Key -> FilePath -> IO Bool downloadUrl state url file = do - putStrLn $ "download: " ++ url - result <- try $ rawSystem "curl" ["-#", "-o", file, url] + putStrLn $ "download: " ++ (show url) + result <- try $ rawSystem "curl" ["-#", "-o", file, (show url)] case (result) of Left _ -> return False Right _ -> return True diff --git a/Locations.hs b/Locations.hs index 72f4c451f..a99ad6ec4 100644 --- a/Locations.hs +++ b/Locations.hs @@ -30,7 +30,7 @@ gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/" - is one to one. - -} keyFile :: Key -> FilePath -keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" key +keyFile key = replace "/" "%" $ replace "%" "%s" $ replace "&" "&a" $ show key {- An annexed file's content is stored in - .git/annex/<backend>/<key> ; this allows deriving the key and backend @@ -16,7 +16,11 @@ data State = State { } deriving (Show) -- annexed filenames are mapped into keys -type Key = FilePath +data Key = Key String deriving (Eq) + +-- show a key to convert it to a string +instance Show Key where + show (Key v) = v -- this structure represents a key/value backend data Backend = Backend { |