diff options
| -rw-r--r-- | Backend/File.hs | 5 | ||||
| -rw-r--r-- | Command/Fsck.hs | 2 | ||||
| -rw-r--r-- | Command/Unused.hs | 4 | ||||
| -rw-r--r-- | Command/Whereis.hs | 4 | ||||
| -rw-r--r-- | Content.hs | 2 | ||||
| -rw-r--r-- | LocationLog.hs | 25 | ||||
| -rw-r--r-- | Remote.hs | 2 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 6 | ||||
| -rw-r--r-- | test.hs | 2 |
9 files changed, 25 insertions, 27 deletions
diff --git a/Backend/File.hs b/Backend/File.hs index 386af0266..20cb3e95a 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -14,7 +14,6 @@ module Backend.File (backend, checkKey) where -import Control.Monad.State (liftIO) import Data.List import Data.String.Utils @@ -132,7 +131,7 @@ showLocations :: Key -> [UUID] -> Annex () showLocations key exclude = do g <- Annex.gitRepo u <- getUUID g - uuids <- liftIO $ keyLocations g key + uuids <- keyLocations g key untrusteduuids <- trustGet UnTrusted let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids) let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted) @@ -190,7 +189,7 @@ checkKeyNumCopies :: Key -> Maybe FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies key file numcopies = do needed <- getNumCopies numcopies g <- Annex.gitRepo - locations <- liftIO $ keyLocations g key + locations <- keyLocations g key untrusted <- trustGet UnTrusted let untrustedlocations = intersect untrusted locations let safelocations = filter (`notElem` untrusted) locations diff --git a/Command/Fsck.hs b/Command/Fsck.hs index adfd702de..7c840d528 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -60,7 +60,7 @@ verifyLocationLog key file = do preventWrite (parentDir f) u <- getUUID g - uuids <- liftIO $ keyLocations g key + uuids <- keyLocations g key case (present, u `elem` uuids) of (True, False) -> do diff --git a/Command/Unused.hs b/Command/Unused.hs index 5422dad69..4389b2209 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -68,7 +68,7 @@ checkRemoteUnused' r = do showNote $ "checking for unused data..." g <- Annex.gitRepo referenced <- getKeysReferenced - logged <- liftIO $ loggedKeys g + logged <- loggedKeys g remotehas <- filterM isthere logged let remoteunused = remotehas `exclude` referenced let list = number 0 remoteunused @@ -79,7 +79,7 @@ checkRemoteUnused' r = do where isthere k = do g <- Annex.gitRepo - us <- liftIO $ keyLocations g k + us <- keyLocations g k return $ uuid `elem` us uuid = Remote.uuid r diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 2e0fa15f6..bcd4a2e22 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -7,8 +7,6 @@ module Command.Whereis where -import Control.Monad.State (liftIO) - import qualified Annex import LocationLog import Command @@ -31,7 +29,7 @@ start file = isAnnexed file $ \(key, _) -> do perform :: Key -> CommandPerform perform key = do g <- Annex.gitRepo - uuids <- liftIO $ keyLocations g key + uuids <- keyLocations g key let num = length uuids showNote $ show num ++ " " ++ copiesplural num if null $ uuids diff --git a/Content.hs b/Content.hs index 57977ce34..ccd51a553 100644 --- a/Content.hs +++ b/Content.hs @@ -81,7 +81,7 @@ logStatusFor :: UUID -> Key -> LogStatus -> Annex () logStatusFor u key status = do g <- Annex.gitRepo unless (Git.repoIsLocalBare g) $ do - logfile <- liftIO $ logChange g key u status + logfile <- logChange g key u status rellogfile <- liftIO $ Git.workTreeFile g logfile AnnexQueue.add "add" [Param "--"] rellogfile diff --git a/LocationLog.hs b/LocationLog.hs index b2d423cf9..1b55abfb2 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -36,6 +36,7 @@ import System.FilePath import qualified Data.Map as Map import Control.Monad (when) import Data.Maybe +import Control.Monad.State (liftIO) import qualified GitRepo as Git import Utility @@ -86,7 +87,7 @@ instance Read LogLine where {- Log a change in the presence of a key's value in a repository, - and returns the filename of the logfile. -} -logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath +logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex FilePath logChange repo key u s = do when (null u) $ error $ "unknown UUID for " ++ Git.repoDescribe repo ++ @@ -100,8 +101,8 @@ logChange repo key u s = do {- Reads a log file. - Note that the LogLines returned may be in any order. -} -readLog :: FilePath -> IO [LogLine] -readLog file = catch (return . parseLog =<< readFileStrict file) (const $ return []) +readLog :: FilePath -> Annex [LogLine] +readLog file = liftIO $ catch (return . parseLog =<< readFileStrict file) (const $ return []) parseLog :: String -> [LogLine] parseLog s = filter parsable $ map read $ lines s @@ -110,18 +111,18 @@ parseLog s = filter parsable $ map read $ lines s parsable l = status l /= Undefined {- Writes a set of lines to a log file -} -writeLog :: FilePath -> [LogLine] -> IO () -writeLog file ls = safeWriteFile file (unlines $ map show ls) +writeLog :: FilePath -> [LogLine] -> Annex () +writeLog file ls = liftIO $ safeWriteFile file (unlines $ map show ls) {- Generates a new LogLine with the current date. -} -logNow :: LogStatus -> UUID -> IO LogLine +logNow :: LogStatus -> UUID -> Annex LogLine logNow s u = do - now <- getPOSIXTime + now <- liftIO $ getPOSIXTime return $ LogLine now s u {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} -keyLocations :: Git.Repo -> Key -> IO [UUID] +keyLocations :: Git.Repo -> Key -> Annex [UUID] keyLocations thisrepo key = do ls <- readLog $ logFile thisrepo key ls' <- readLog $ logFileOld thisrepo key @@ -155,18 +156,18 @@ mapLog m l = {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} -loggedKeys :: Git.Repo -> IO [Key] +loggedKeys :: Git.Repo -> Annex [Key] loggedKeys repo = do - exists <- doesDirectoryExist dir + exists <- liftIO $ doesDirectoryExist dir if exists then do -- 2 levels of hashing - levela <- dirContents dir + levela <- liftIO $ dirContents dir levelb <- mapM tryDirContents levela files <- mapM tryDirContents (concat levelb) return $ catMaybes $ map (logFileKey . takeFileName) (concat files) else return [] where - tryDirContents d = catch (dirContents d) (return . const []) + tryDirContents d = liftIO $ catch (dirContents d) (return . const []) dir = gitStateDir repo @@ -141,7 +141,7 @@ keyPossibilities key = do trusted <- trustGet Trusted -- get uuids of all remotes that are recorded to have the key - uuids <- liftIO $ keyLocations g key + uuids <- keyLocations g key let validuuids = filter (/= u) uuids -- note that validuuids is assumed to not have dups diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 1e634e00e..c09bd74c1 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -134,9 +134,9 @@ moveLocationLogs = do -- log files that are not checked into git, -- as well as merging with already upgraded -- logs that have been pulled from elsewhere - old <- liftIO $ readLog f - new <- liftIO $ readLog dest - liftIO $ writeLog dest (old++new) + old <- readLog f + new <- readLog dest + writeLog dest (old++new) AnnexQueue.add "add" [Param "--"] dest AnnexQueue.add "add" [Param "--"] f AnnexQueue.add "rm" [Param "--quiet", Param "-f", Param "--"] f @@ -611,7 +611,7 @@ checklocationlog f expected = do Just (k, _) -> do uuids <- annexeval $ do g <- Annex.gitRepo - liftIO $ LocationLog.keyLocations g k + LocationLog.keyLocations g k assertEqual ("bad content in location log for " ++ f ++ " key " ++ (show k) ++ " uuid " ++ thisuuid) expected (thisuuid `elem` uuids) |