move supportedBackends list into annex monad
This was necessary so the File backend could import Backend w/o a cycle. Moved code that checks whether enough backends have a file into File backend.
This commit is contained in:
parent
6bfa534aa4
commit
b471822cfe
7 changed files with 105 additions and 95 deletions
50
Commands.hs
50
Commands.hs
|
@ -16,7 +16,6 @@ import qualified Annex
|
|||
import Utility
|
||||
import Locations
|
||||
import qualified Backend
|
||||
import BackendList
|
||||
import UUID
|
||||
import LocationLog
|
||||
import Types
|
||||
|
@ -169,10 +168,6 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do
|
|||
if (not inbackend)
|
||||
then return () -- no-op
|
||||
else do
|
||||
force <- Annex.flagIsSet Force
|
||||
if (not force)
|
||||
then requireEnoughCopies key
|
||||
else return ()
|
||||
success <- Backend.removeKey backend key
|
||||
if (success)
|
||||
then cleanup key
|
||||
|
@ -235,51 +230,8 @@ logStatus key status = do
|
|||
gitAdd f Nothing -- all logs are committed at end
|
||||
|
||||
inBackend file yes no = do
|
||||
r <- liftIO $ Backend.lookupFile file
|
||||
r <- Backend.lookupFile file
|
||||
case (r) of
|
||||
Just v -> yes v
|
||||
Nothing -> no
|
||||
notinBackend file yes no = inBackend file no yes
|
||||
|
||||
{- 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
|
||||
- error if not. -}
|
||||
requireEnoughCopies :: Key -> Annex ()
|
||||
requireEnoughCopies key = do
|
||||
g <- Annex.gitRepo
|
||||
let numcopies = read $ Git.configGet g config "1"
|
||||
remotes <- Remotes.withKey key
|
||||
if (numcopies > length remotes)
|
||||
then error $ "I only know about " ++ (show $ length remotes) ++
|
||||
" out of " ++ (show numcopies) ++
|
||||
" necessary copies of: " ++ (keyFile key) ++
|
||||
unsafe
|
||||
else findcopies numcopies remotes []
|
||||
where
|
||||
findcopies 0 _ _ = return () -- success, enough copies found
|
||||
findcopies _ [] bad = die bad
|
||||
findcopies n (r:rs) bad = do
|
||||
result <- liftIO $ try $ haskey r
|
||||
case (result) of
|
||||
Right True -> findcopies (n-1) rs bad
|
||||
Right False -> findcopies n rs bad
|
||||
Left _ -> findcopies n rs (r:bad)
|
||||
haskey r = do
|
||||
-- To check if a remote has a key, construct a new
|
||||
-- Annex monad and query its backend.
|
||||
a <- Annex.new r
|
||||
(result, _) <- Annex.run a (Backend.hasKey key)
|
||||
return result
|
||||
die bad =
|
||||
error $ "I failed to find enough other copies of: " ++
|
||||
(keyFile key) ++
|
||||
(if (0 /= length bad) then listbad bad else "")
|
||||
++ unsafe
|
||||
listbad bad = "\nI was unable to access these remotes: " ++
|
||||
(Remotes.list bad)
|
||||
unsafe = "\n" ++
|
||||
" -- According to the " ++ config ++
|
||||
" setting, it is not safe to remove it!\n" ++
|
||||
" (Use --force to override.)"
|
||||
|
||||
config = "annex.numcopies"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue