aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-13 02:31:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-13 02:31:24 -0400
commitd1071bd1fe879abb3ebb229f9347f7855a697b8c (patch)
treedb9df662b58f2b0762252f4d22b5cb244c8be978
parent490a3a828cbb5a4046178b36fc0f9fe0696d0e9d (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.hs21
-rw-r--r--Backend.hs54
-rw-r--r--BackendFile.hs5
-rw-r--r--BackendUrl.hs4
-rw-r--r--Locations.hs2
-rw-r--r--Types.hs6
6 files changed, 54 insertions, 38 deletions
diff --git a/Annex.hs b/Annex.hs
index 63cf0d2fb..8a7b8d860 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -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
diff --git a/Types.hs b/Types.hs
index 73492dfc3..9b0bb00fd 100644
--- a/Types.hs
+++ b/Types.hs
@@ -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 {