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 | |
parent | 57adb0347bf4eb71ab846a2947680a20263449a2 (diff) |
finished hlinting
Diffstat (limited to 'Backend')
-rw-r--r-- | Backend/File.hs | 78 | ||||
-rw-r--r-- | Backend/SHA1.hs | 10 | ||||
-rw-r--r-- | Backend/WORM.hs | 10 |
3 files changed, 45 insertions, 53 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 diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index 46667c9cd..68f7f683b 100644 --- a/Backend/SHA1.hs +++ b/Backend/SHA1.hs @@ -33,15 +33,15 @@ sha1 file = do liftIO $ pOpen ReadFromPipe "sha1sum" [file] $ \h -> do line <- hGetLine h let bits = split " " line - if (null bits) + if null bits then error "sha1sum parse error" - else return $ bits !! 0 + else return $ head bits -- A key is a sha1 of its contents. keyValue :: FilePath -> Annex (Maybe Key) keyValue file = do s <- sha1 file - return $ Just $ Key ((name backend), s) + return $ Just $ Key (name backend, s) -- A key's sha1 is checked during fsck. checkKeySHA1 :: Key -> Annex Bool @@ -49,11 +49,11 @@ checkKeySHA1 key = do g <- Annex.gitRepo let file = annexLocation g key present <- liftIO $ doesFileExist file - if (not present) + if not present then return True else do s <- sha1 file - if (s == keyName key) + if s == keyName key then return True else do dest <- moveBad key diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 4e2177fed..e9d8c4285 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -37,11 +37,11 @@ backend = Backend.File.backend { keyValue :: FilePath -> Annex (Maybe Key) keyValue file = do stat <- liftIO $ getFileStatus file - return $ Just $ Key ((name backend), key stat) + return $ Just $ Key (name backend, key stat) where key stat = uniqueid stat ++ sep ++ base - uniqueid stat = (show $ modificationTime stat) ++ sep ++ - (show $ fileSize stat) + uniqueid stat = show (modificationTime stat) ++ sep ++ + show (fileSize stat) base = takeFileName file sep = ":" @@ -58,11 +58,11 @@ checkKeySize key = do g <- Annex.gitRepo let file = annexLocation g key present <- liftIO $ doesFileExist file - if (not present) + if not present then return True else do s <- liftIO $ getFileStatus file - if (fileSize s == keySize key) + if fileSize s == keySize key then return True else do dest <- moveBad key |