diff options
author | Joey Hess <joey@kitenet.net> | 2010-11-22 17:51:55 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-11-22 17:51:55 -0400 |
commit | eeae91024285c85a7e77b1b44e501a63bced7154 (patch) | |
tree | ece6c1d1e670e04001dd570a375ed9954078da0a /Backend/File.hs | |
parent | 57adb0347bf4eb71ab846a2947680a20263449a2 (diff) |
finished hlinting
Diffstat (limited to 'Backend/File.hs')
-rw-r--r-- | Backend/File.hs | 78 |
1 files changed, 35 insertions, 43 deletions
diff --git a/Backend/File.hs b/Backend/File.hs index c67fb3ce3..c0fc46992 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -34,7 +34,7 @@ backend = Backend { storeFileKey = dummyStore, retrieveKeyFile = copyKeyFile, removeKey = checkRemoveKey, - hasKey = checkKeyFile, + hasKey = inAnnex, fsckKey = mustProvide } @@ -42,19 +42,15 @@ mustProvide :: a mustProvide = error "must provide this field" {- Storing a key is a no-op. -} -dummyStore :: FilePath -> Key -> Annex (Bool) +dummyStore :: FilePath -> Key -> Annex Bool dummyStore _ _ = return True -{- Just check if the .git/annex/ file for the key exists. -} -checkKeyFile :: Key -> Annex Bool -checkKeyFile k = inAnnex k - {- Try to find a copy of the file in one of the remotes, - and copy it over to this one. -} -copyKeyFile :: Key -> FilePath -> Annex (Bool) +copyKeyFile :: Key -> FilePath -> Annex Bool copyKeyFile key file = do remotes <- Remotes.keyPossibilities key - if (null remotes) + if null remotes then do showNote "not available" showLocations key @@ -68,76 +64,72 @@ copyKeyFile key file = do return False trycopy full (r:rs) = do probablythere <- probablyPresent r - if (probablythere) + if probablythere then do - showNote $ "copying from " ++ (Git.repoDescribe r) ++ "..." + showNote $ "copying from " ++ Git.repoDescribe r ++ "..." copied <- Remotes.copyFromRemote r key file - if (copied) + if copied then return True else trycopy full rs else trycopy full rs - probablyPresent r = do - -- This check is to avoid an ugly message if a - -- remote is a drive that is not mounted. - -- Avoid checking inAnnex for ssh remotes because - -- that is unnecessarily slow, and the locationlog - -- should be trusted. (If the ssh remote is down - -- or really lacks the file, it's ok to show - -- an ugly message before going on to the next - -- remote.) - if (not $ Git.repoIsUrl r) + -- This check is to avoid an ugly message if a remote is a + -- drive that is not mounted. Avoid checking inAnnex for ssh + -- remotes because that is unnecessarily slow, and the + -- locationlog should be trusted. (If the ssh remote is down + -- or really lacks the file, it's ok to show an ugly message + -- before going on to the next remote.) + probablyPresent r = + if not $ Git.repoIsUrl r then liftIO $ doesFileExist $ annexLocation r key else return True {- 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. -} -checkRemoveKey :: Key -> Annex (Bool) +checkRemoveKey :: Key -> Annex Bool checkRemoveKey key = do force <- Annex.flagIsSet "force" - if (force) + if force then return True else do remotes <- Remotes.keyPossibilities key numcopies <- getNumCopies - if (numcopies > length remotes) + if numcopies > length remotes then notEnoughCopies numcopies (length remotes) [] else findcopies numcopies 0 remotes [] where - findcopies need have [] bad = - if (have >= need) - then return True - else notEnoughCopies need have bad - findcopies need have (r:rs) bad = do - if (have >= need) - then return True - else do - haskey <- Remotes.inAnnex r key - case (haskey) of - Right True -> findcopies need (have+1) rs bad - Right False -> findcopies need have rs bad - Left _ -> findcopies need have rs (r:bad) + findcopies need have [] bad + | have >= need = return True + | otherwise = notEnoughCopies need have bad + findcopies need have (r:rs) bad + | have >= need = return True + | otherwise = do + haskey <- Remotes.inAnnex r key + case haskey of + Right True -> findcopies need (have+1) rs bad + Right False -> findcopies need have rs bad + Left _ -> findcopies need have rs (r:bad) notEnoughCopies need have bad = do unsafe showLongNote $ "Could only verify the existence of " ++ - (show have) ++ " out of " ++ (show need) ++ + show have ++ " out of " ++ show need ++ " necessary copies" showTriedRemotes bad showLocations key hint return False unsafe = showNote "unsafe" - hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)" + hint = showLongNote "(Use --force to override this check, or adjust annex.numcopies.)" showLocations :: Key -> Annex () showLocations key = do g <- Annex.gitRepo u <- getUUID g uuids <- liftIO $ keyLocations g key - let uuidsf = filter (\v -> v /= u) uuids + let uuidsf = filter (/= u) uuids ppuuids <- prettyPrintUUIDs uuidsf - if (null uuidsf) + if null uuidsf then showLongNote $ "No other repository is known to contain the file." else showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids @@ -145,7 +137,7 @@ showTriedRemotes :: [Git.Repo] -> Annex () showTriedRemotes [] = return () showTriedRemotes remotes = showLongNote $ "I was unable to access these remotes: " ++ - (Remotes.list remotes) + Remotes.list remotes getNumCopies :: Annex Int getNumCopies = do @@ -173,7 +165,7 @@ checkKeyNumCopies key = do remotes <- Remotes.keyPossibilities key inannex <- inAnnex key let present = length remotes + if inannex then 1 else 0 - if (present < needed) + if present < needed then do warning $ note present needed return False |