diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-13 16:21:50 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-13 16:21:50 -0400 |
commit | f87c5ed9496f50646d9f5e8be540f8bc059db242 (patch) | |
tree | 08c5bfede3fb07573a6859b576a45a3ac84d3a1b | |
parent | e28ff5bdaf7ce56c0c928904ff883c1e2cd093de (diff) |
copying almost working
-rw-r--r-- | Annex.hs | 10 | ||||
-rw-r--r-- | BackendFile.hs | 35 | ||||
-rw-r--r-- | Locations.hs | 20 | ||||
-rw-r--r-- | git-annex.hs | 3 |
4 files changed, 44 insertions, 24 deletions
@@ -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 () |