summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-13 16:21:50 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-13 16:21:50 -0400
commitf87c5ed9496f50646d9f5e8be540f8bc059db242 (patch)
tree08c5bfede3fb07573a6859b576a45a3ac84d3a1b
parente28ff5bdaf7ce56c0c928904ff883c1e2cd093de (diff)
copying almost working
-rw-r--r--Annex.hs10
-rw-r--r--BackendFile.hs35
-rw-r--r--Locations.hs20
-rw-r--r--git-annex.hs3
4 files changed, 44 insertions, 24 deletions
diff --git a/Annex.hs b/Annex.hs
index 834c26115..8489c2ca6 100644
--- a/Annex.hs
+++ b/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 reldest = annexLocationRelative state backend key
+ let dest = annexLocation (repo 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
diff --git a/BackendFile.hs b/BackendFile.hs
index d4d137e53..adb8da8bd 100644
--- a/BackendFile.hs
+++ b/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
- if (ok)
- then return True
- else trycopy full rs
+ putStrLn "trying a remote"
+ result <- try (copyFromRemote r key file)::IO (Either SomeException ())
+ case (result) of
+ 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. -}
-copyFromRemote :: GitRepo -> Key -> FilePath -> IO (Bool)
+{- Tries to copy a file from a remote, exception on error. -}
+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
diff --git a/Locations.hs b/Locations.hs
index 304ca060e..d6d7d4248 100644
--- a/Locations.hs
+++ b/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
- - by looking at the symlink to it. -}
-annexLocation :: State -> Backend -> Key -> FilePath
-annexLocation state backend key =
- (gitWorkTree $ repo state) ++ "/" ++
- (annexLocationRelative state backend key)
+ - /path/to/repo/.git/annex/<backend>/<key>
+ -
+ - (That allows deriving the key and backend by looking at the symlink to it.)
+ -}
+annexLocation :: GitRepo -> Backend -> Key -> FilePath
+annexLocation r backend key =
+ (gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key)
{- Annexed file's location relative to the gitWorkTree -}
-annexLocationRelative :: State -> Backend -> Key -> FilePath
-annexLocationRelative state backend key =
- gitDir (repo state) ++ "/annex/" ++ (name backend) ++
- "/" ++ (keyFile key)
+annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath
+annexLocationRelative r backend key =
+ gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key)
{- Converts a key into a filename fragment.
-
diff --git a/git-annex.hs b/git-annex.hs
index 7bcd4de22..7785e4f2d 100644
--- a/git-annex.hs
+++ b/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: " ++ err
+ hPutStrLn stderr $ "git-annex: " ++ (show e)
return ()