better drop error messages
This commit is contained in:
parent
3531ce5c54
commit
ed3f6653b6
2 changed files with 30 additions and 21 deletions
|
@ -15,6 +15,8 @@ import System.IO
|
||||||
import System.Cmd
|
import System.Cmd
|
||||||
import System.Cmd.Utils
|
import System.Cmd.Utils
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
import List
|
||||||
|
import Maybe
|
||||||
|
|
||||||
import TypeInternals
|
import TypeInternals
|
||||||
import LocationLog
|
import LocationLog
|
||||||
|
@ -52,7 +54,10 @@ copyKeyFile :: Key -> FilePath -> Annex (Bool)
|
||||||
copyKeyFile key file = do
|
copyKeyFile key file = do
|
||||||
remotes <- Remotes.withKey key
|
remotes <- Remotes.withKey key
|
||||||
if (0 == length remotes)
|
if (0 == length remotes)
|
||||||
then cantfind
|
then do
|
||||||
|
showNote $ "No available git remotes have the file."
|
||||||
|
showLocations key
|
||||||
|
return False
|
||||||
else trycopy remotes remotes
|
else trycopy remotes remotes
|
||||||
where
|
where
|
||||||
trycopy full [] = do
|
trycopy full [] = do
|
||||||
|
@ -70,15 +75,6 @@ copyKeyFile key file = do
|
||||||
Just r' -> do
|
Just r' -> do
|
||||||
showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
|
showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
|
||||||
liftIO $ copyFromRemote r' key file
|
liftIO $ copyFromRemote r' key file
|
||||||
cantfind = do
|
|
||||||
g <- Annex.gitRepo
|
|
||||||
uuids <- liftIO $ keyLocations g key
|
|
||||||
ppuuids <- prettyPrintUUIDs uuids
|
|
||||||
showNote $ "No available git remotes have the file."
|
|
||||||
if (0 < length uuids)
|
|
||||||
then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids
|
|
||||||
else return ()
|
|
||||||
return False
|
|
||||||
|
|
||||||
{- Tries to copy a file from a remote. -}
|
{- Tries to copy a file from a remote. -}
|
||||||
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
|
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
|
||||||
|
@ -90,6 +86,17 @@ copyFromRemote r key file = do
|
||||||
getlocal = boolSystem "cp" ["-a", location, file]
|
getlocal = boolSystem "cp" ["-a", location, file]
|
||||||
getremote = return False -- TODO implement get from remote
|
getremote = return False -- TODO implement get from remote
|
||||||
location = annexLocation r key
|
location = annexLocation r key
|
||||||
|
|
||||||
|
showLocations :: Key -> Annex ()
|
||||||
|
showLocations key = do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
u <- getUUID g
|
||||||
|
uuids <- liftIO $ keyLocations g key
|
||||||
|
let uuidsf = filter (\v -> v /= u) uuids
|
||||||
|
ppuuids <- prettyPrintUUIDs uuidsf
|
||||||
|
if (0 < length uuidsf)
|
||||||
|
then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
|
||||||
|
else showLongNote $ "No other repository is known to contain the file."
|
||||||
|
|
||||||
{- 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
|
||||||
- for a key to be safely removed (with no data loss), and fails with an
|
- for a key to be safely removed (with no data loss), and fails with an
|
||||||
|
@ -125,22 +132,24 @@ checkRemoveKey key = do
|
||||||
(result, _) <- Annex.run a (Backend.hasKey key)
|
(result, _) <- Annex.run a (Backend.hasKey key)
|
||||||
return result
|
return result
|
||||||
notEnoughCopiesSeen bad = do
|
notEnoughCopiesSeen bad = do
|
||||||
showNote "failed to find enough other copies of the file"
|
|
||||||
if (0 /= length bad) then listbad bad else return ()
|
|
||||||
unsafe
|
unsafe
|
||||||
|
if (0 /= length bad) then listbad bad else return ()
|
||||||
|
showLocations key
|
||||||
|
hint
|
||||||
return False
|
return False
|
||||||
listbad bad =
|
listbad bad =
|
||||||
showLongNote $
|
showLongNote $
|
||||||
"I was unable to access these remotes: " ++
|
"I was unable to access these remotes: " ++
|
||||||
(Remotes.list bad)
|
(Remotes.list bad)
|
||||||
retNotEnoughCopiesKnown remotes numcopies = do
|
retNotEnoughCopiesKnown remotes numcopies = do
|
||||||
showNote $
|
|
||||||
"I only know about " ++ (show $ length remotes) ++
|
|
||||||
" out of " ++ (show numcopies) ++
|
|
||||||
" necessary copies of the file"
|
|
||||||
unsafe
|
unsafe
|
||||||
|
showLongNote $
|
||||||
|
"Could only verify the existence of " ++
|
||||||
|
(show $ length remotes) ++
|
||||||
|
" out of " ++ (show numcopies) ++
|
||||||
|
" necessary copies"
|
||||||
|
showLocations key
|
||||||
|
hint
|
||||||
return False
|
return False
|
||||||
unsafe = do
|
unsafe = showNote "unsafe"
|
||||||
showLongNote $ "According to the " ++ config ++
|
hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)"
|
||||||
" setting, it is not safe to remove it!"
|
|
||||||
showLongNote "(Use --force to override.)"
|
|
||||||
|
|
2
UUID.hs
2
UUID.hs
|
@ -51,7 +51,7 @@ getUUID r = do
|
||||||
|
|
||||||
let c = cached r g
|
let c = cached r g
|
||||||
let u = uncached r
|
let u = uncached r
|
||||||
|
|
||||||
if (c /= u && u /= "")
|
if (c /= u && u /= "")
|
||||||
then do
|
then do
|
||||||
updatecache g r u
|
updatecache g r u
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue