copying almost working

Annex.hs

@@ -64,8 +64,8 @@ annexFile state file = inBackend file err $ do
 				else return ()
 		setup key backend = do
 			logStatus state key ValuePresent
-			let dest = annexLocation state backend key
+			let dest = annexLocation (repo state) backend key
-			let reldest = annexLocationRelative state backend key
+			let reldest = annexLocationRelative (repo state) backend key
 			createDirectoryIfMissing True (parentDir dest)
 			renameFile file dest
 			createSymbolicLink ((linkTarget file) ++ reldest) file
@@ -94,7 +94,7 @@ unannexFile state file = notinBackend file err $ \(key, backend) -> do
 	-- git rm deletes empty directories;
 	-- put them back
 	createDirectoryIfMissing True (parentDir file)
-	let src = annexLocation state backend key
+	let src = annexLocation (repo state) backend key
 	renameFile src file
 	return ()
 	where
@@ -107,7 +107,7 @@ annexGetFile state file = notinBackend file err $ \(key, backend) -> do
 	if (inannex)
 		then return ()
 		else do
-			let dest = annexLocation state backend key
+			let dest = annexLocation (repo state) backend key
 			createDirectoryIfMissing True (parentDir dest)
 			success <- retrieveFile state backend key dest
 			if (success)
@@ -166,4 +166,4 @@ logStatus state key status = do
 
 {- Checks if a given key is currently present in the annexLocation -}
 inAnnex :: State -> Backend -> Key -> IO Bool
-inAnnex state backend key = doesFileExist $ annexLocation state backend key
+inAnnex state backend key = doesFileExist $ annexLocation (repo state) backend key

BackendFile.hs

@@ -3,6 +3,9 @@
 
 module BackendFile (backend) where
 
+import System.IO
+import System.Cmd
+import Control.Exception
 import Types
 import LocationLog
 import Locations
@@ -45,12 +48,30 @@ copyKeyFile state key file = do
 			"To get that file, need access to one of these remotes: " ++
 			(remotesList full)
 		trycopy full (r:rs) = do
-			ok <- copyFromRemote r key file
+			putStrLn "trying a remote"
-			if (ok)
+			result <- try (copyFromRemote r key file)::IO (Either SomeException ())
-				then return True
+        		case (result) of
-				else trycopy full rs
+		                Left err -> do
+					showerr err r
+					trycopy full rs
+		                Right succ -> return True
+		showerr err r = do
+			hPutStrLn stderr $ "git-annex: copy from " ++ 
+				(gitRepoDescribe r ) ++ " failed: " ++
+				(show err)
 
-{- Tries to copy a file from a remote. -}
+{- Tries to copy a file from a remote, exception on error. -}
-copyFromRemote :: GitRepo -> Key -> FilePath -> IO (Bool)
+copyFromRemote :: GitRepo -> Key -> FilePath -> IO ()
 copyFromRemote r key file = do
-	return False -- TODO	
+	r <- if (gitRepoIsLocal r)
+		then getlocal
+		else getremote
+	return ()
+	where
+		getlocal = do
+			putStrLn $ "get: " ++ location
+			rawSystem "cp" ["-a", location, file]
+		getremote = do
+			putStrLn $ "get: " ++ location
+			error "get via network not yet implemented!"
+		location = annexLocation r backend key

Locations.hs

@@ -21,18 +21,18 @@ gitStateDir :: GitRepo -> FilePath
 gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"
 
 {- An annexed file's content is stored in 
- - .git/annex/<backend>/<key> ; this allows deriving the key and backend
+ - /path/to/repo/.git/annex/<backend>/<key>
- - by looking at the symlink to it. -}
+ -
-annexLocation :: State -> Backend -> Key -> FilePath
+ - (That allows deriving the key and backend by looking at the symlink to it.)
-annexLocation state backend key = 
+ -}
-	(gitWorkTree $ repo state) ++ "/" ++ 
+annexLocation :: GitRepo -> Backend -> Key -> FilePath
-	(annexLocationRelative state backend key)
+annexLocation r backend key = 
+	(gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key)
 
 {- Annexed file's location relative to the gitWorkTree -}
-annexLocationRelative :: State -> Backend -> Key -> FilePath
+annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath
-annexLocationRelative state backend key = 
+annexLocationRelative r backend key = 
-	gitDir (repo state) ++ "/annex/" ++ (name backend) ++ 
+	gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key)
-		"/" ++ (keyFile key)
 
 {- Converts a key into a filename fragment.
  -

git-annex.hs

@@ -32,6 +32,5 @@ tryRun errnum oknum (a:as) = do
 {- Exception pretty-printing. -}
 showErr :: SomeException -> IO ()
 showErr e = do
-	let err = show e
+	hPutStrLn stderr $ "git-annex: " ++ (show e)
-	hPutStrLn stderr $ "git-annex: " ++ err
 	return ()