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.

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
+			key <- fileKey file
-			case (mkey) of
+			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

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 -> Key -> FilePath -> IO Bool
-retrieveFile state file dest = do
+retrieveFile state key dest = do
-	result <- lookupBackend state file
+	result <- lookupBackend state key
 	case (result) of
 		Nothing -> return False
-		Just backend -> do
+		Just backend -> (retrieveKeyFile backend) state key dest
-			key <- fileKey file
-			(retrieveKeyFile backend) state key dest
 
-{- Drops the key for a file from the backend that has it. -}
+{- Drops a key from the backend that has it. -}
-dropFile :: State -> FilePath -> IO (Maybe (Key, Backend))
+dropFile :: State -> Key -> IO (Maybe (Key, Backend))
-dropFile state file = do
+dropFile state key = do
-	result <- lookupBackend state file
+	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. -}
+{- Looks up the backend that has a key. -}
-lookupBackend :: State -> FilePath -> IO (Maybe Backend)
+lookupBackend :: State -> Key -> IO (Maybe Backend)
-lookupBackend state file = lookupBackend' (backends state) state file
+lookupBackend state key = lookupBackend' (backends state) state key
 lookupBackend' [] _ _ = return Nothing
-lookupBackend' (b:bs) state file = do
+lookupBackend' (b:bs) state key = do
-	present <- checkBackend b state file
+	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. -}
+{- Checks if a key is available via a given backend. -}
-checkBackend :: Backend -> State -> FilePath -> IO (Bool)
+checkBackend :: Backend -> State -> Key -> IO (Bool)
-checkBackend backend state file = 
+checkBackend backend state key = 
-	doesFileExist $ annexLocation state backend file
+	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

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

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
+	putStrLn $ "download: " ++ (show url)
-	result <- try $ rawSystem "curl" ["-#", "-o", file, url]
+	result <- try $ rawSystem "curl" ["-#", "-o", file, (show url)]
 	case (result) of
 		Left _ -> return False
 		Right _ -> return True

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

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 {