move LocationLog into Annex monad from IO

It will need to run in Annex so it can use Branch

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

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

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
 

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

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
 

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 :: FilePath -> Annex [LogLine]
-readLog file = catch (return . parseLog =<< readFileStrict file) (const $ return [])
+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 :: FilePath -> [LogLine] -> Annex ()
-writeLog file ls = safeWriteFile file (unlines $ map show ls)
+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

Remote.hs

@@ -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

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
+				old <- readLog f
-				new <- liftIO $ readLog dest
+				new <- readLog dest
-				liftIO $ writeLog dest (old++new)
+				writeLog dest (old++new)
 				AnnexQueue.add "add" [Param "--"] dest
 				AnnexQueue.add "add" [Param "--"] f
 				AnnexQueue.add "rm" [Param "--quiet", Param "-f", Param "--"] f

test.hs

@@ -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)