mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

use boolSystem

Browse source
This commit is contained in:
Joey Hess 2010-10-19 01:46:07 -04:00
parent 7afac11344
commit 470e0a2fbd
1 changed files with 5 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Backend/File.hs
View file

@ -14,7 +14,6 @@ import Control.Monad.State
import System.IO import System.IO
import System.Cmd import System.Cmd
import System.Cmd.Utils import System.Cmd.Utils
import System.Exit
import Control.Exception import Control.Exception
import TypeInternals import TypeInternals
@ -70,12 +69,7 @@ copyKeyFile key file = do
Nothing -> trycopy full rs Nothing -> trycopy full rs
Just r' -> do Just r' -> do
showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) liftIO $ copyFromRemote r' key file
case (result) of
Left err -> do
liftIO $ hPutStrLn stderr (show err)
trycopy full rs
Right succ -> return True
cantfind = do cantfind = do
g <- Annex.gitRepo g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key uuids <- liftIO $ keyLocations g key
@ -86,15 +80,15 @@ copyKeyFile key file = do
else return () else return ()
return False return False
{- Tries to copy a file from a remote, exception on error. -} {- Tries to copy a file from a remote. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
copyFromRemote r key file = do copyFromRemote r key file = do
if (Git.repoIsLocal r) if (Git.repoIsLocal r)
then getlocal then getlocal
else getremote else getremote
where where
getlocal = safeSystem "cp" ["-a", location, file] getlocal = boolSystem "cp" ["-a", location, file]
getremote = error "get via network not yet implemented!" getremote = return False -- TODO implement get from remote
location = annexLocation r key location = annexLocation r key
{- Checks remotes to verify that enough copies of a key exist to allow {- Checks remotes to verify that enough copies of a key exist to allow