diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-14 20:05:04 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-14 20:05:04 -0400 |
commit | 4c3ad80f320d3c4cccc3e41e4f2364155bae22a1 (patch) | |
tree | 5c09b65168929801291f2d5f84250a88e53d5394 | |
parent | b8ba60428a0b4c077482560757e830e9ba02a823 (diff) |
bugfix
-rw-r--r-- | Backend.hs | 20 | ||||
-rw-r--r-- | Backend/Url.hs | 11 | ||||
-rw-r--r-- | BackendList.hs | 2 | ||||
-rw-r--r-- | BackendTypes.hs | 8 | ||||
-rw-r--r-- | TODO | 3 | ||||
-rw-r--r-- | Types.hs | 4 |
6 files changed, 26 insertions, 22 deletions
diff --git a/Backend.hs b/Backend.hs index 47e42b822..f419831d2 100644 --- a/Backend.hs +++ b/Backend.hs @@ -78,17 +78,9 @@ retrieveKeyFile backend key dest = (B.retrieveKeyFile backend) key dest removeKey :: Backend -> Key -> Annex Bool removeKey backend key = (B.removeKey backend) key -{- Checks if any backend has a key. -} +{- Checks if a backend has its key. -} hasKey :: Key -> Annex Bool -hasKey key = do - b <- backendList - hasKey' b key -hasKey' [] key = return False -hasKey' (b:bs) key = do - has <- (B.hasKey b) key - if (has) - then return True - else hasKey' bs key +hasKey key = (B.hasKey (lookupBackendName $ backendName key)) key {- Looks up the key and backend corresponding to an annexed file, - by examining what the file symlinks to. -} @@ -101,6 +93,8 @@ lookupFile file = do where lookup = do l <- readSymbolicLink file - return $ Just (k l, b l) - k l = fileKey $ takeFileName $ l - b l = lookupBackendName $ takeFileName $ parentDir $ l + return $ Just $ pair $ takeFileName l + pair file = (k, b) + where + k = fileKey file + b = lookupBackendName $ backendName k diff --git a/Backend/Url.hs b/Backend/Url.hs index 325a7e217..e23767208 100644 --- a/Backend/Url.hs +++ b/Backend/Url.hs @@ -3,7 +3,8 @@ module Backend.Url (backend) where -import Control.Monad.State +import Control.Monad.State (liftIO) +import Data.String.Utils import System.Cmd import System.Exit import BackendTypes @@ -30,9 +31,11 @@ dummyOk :: Key -> Annex Bool dummyOk url = return True downloadUrl :: Key -> FilePath -> Annex Bool -downloadUrl url file = do - liftIO $ putStrLn $ "download: " ++ (show url) - result <- liftIO $ rawSystem "curl" ["-#", "-o", file, (show url)] +downloadUrl key file = do + liftIO $ putStrLn $ "download: " ++ url + result <- liftIO $ rawSystem "curl" ["-#", "-o", file, url] if (result == ExitSuccess) then return True else return False + where + url = join ":" $ drop 1 $ split ":" $ show key diff --git a/BackendList.hs b/BackendList.hs index e9f926ce2..b66110905 100644 --- a/BackendList.hs +++ b/BackendList.hs @@ -28,7 +28,7 @@ parseBackendList s = then supportedBackends else map (lookupBackendName) $ words s -{- Looks up a supported backed by name. -} +{- Looks up a supported backend by name. -} lookupBackendName :: String -> Backend lookupBackendName s = if ((length matches) /= 1) diff --git a/BackendTypes.hs b/BackendTypes.hs index e0f5f7373..41ff7e506 100644 --- a/BackendTypes.hs +++ b/BackendTypes.hs @@ -36,6 +36,14 @@ instance Read Key where b = l !! 0 k = join ":" $ drop 1 l +-- pulls the backend name out +backendName :: Key -> BackendName +backendName (Key (b,k)) = b + +-- pulls the key fragment out +keyFrag :: Key -> KeyFrag +keyFrag (Key (b,k)) = k + -- this structure represents a key/value backend data Backend = Backend { -- name of this backend @@ -1,9 +1,6 @@ * bug when annexing files while in a subdir of a git repo * bug when specifying absolute path to files when annexing -* need to include backend name as part of the key, because currently - if two backends have overlapping key spaces, it can confuse things - * --push/--pull/--want * how to handle git mv file? @@ -3,8 +3,10 @@ module Types ( Annex, AnnexState, + Backend, Key, - Backend + backendName, + keyFrag ) where import BackendTypes |