summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 20:05:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 20:05:04 -0400
commit4c3ad80f320d3c4cccc3e41e4f2364155bae22a1 (patch)
tree5c09b65168929801291f2d5f84250a88e53d5394
parentb8ba60428a0b4c077482560757e830e9ba02a823 (diff)
bugfix
-rw-r--r--Backend.hs20
-rw-r--r--Backend/Url.hs11
-rw-r--r--BackendList.hs2
-rw-r--r--BackendTypes.hs8
-rw-r--r--TODO3
-rw-r--r--Types.hs4
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
diff --git a/TODO b/TODO
index 70ace863e..c4ce74e19 100644
--- a/TODO
+++ b/TODO
@@ -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?
diff --git a/Types.hs b/Types.hs
index 4262ed567..a0f120db0 100644
--- a/Types.hs
+++ b/Types.hs
@@ -3,8 +3,10 @@
module Types (
Annex,
AnnexState,
+ Backend,
Key,
- Backend
+ backendName,
+ keyFrag
) where
import BackendTypes