rename

1 files changed, 0 insertions, 237 deletions

diff --git a/Content.hs b/Content.hs
deleted file mode 100644
index 567e4caa5..000000000
--- a/Content.hs
+++ /dev/null
@@ -1,237 +0,0 @@
-{- git-annex file content managing
- -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Content (
-	inAnnex,
-	calcGitLink,
-	logStatus,
-	getViaTmp,
-	getViaTmpUnchecked,
-	withTmp,
-	checkDiskSpace,
-	moveAnnex,
-	removeAnnex,
-	fromAnnex,
-	moveBad,
-	getKeysPresent,
-	saveState
-) where
-
-import AnnexCommon
-import LocationLog
-import UUID
-import qualified Git
-import qualified Annex
-import qualified AnnexQueue
-import qualified Branch
-import Utility.StatFS
-import Utility.FileMode
-import Types.Key
-import Utility.DataUnits
-import Config
-
-{- Checks if a given key is currently present in the gitAnnexLocation. -}
-inAnnex :: Key -> Annex Bool
-inAnnex key = do
-	g <- gitRepo
-	when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
-	liftIO $ doesFileExist $ gitAnnexLocation g key
-
-{- Calculates the relative path to use to link a file to a key. -}
-calcGitLink :: FilePath -> Key -> Annex FilePath
-calcGitLink file key = do
-	g <- gitRepo
-	cwd <- liftIO getCurrentDirectory
-	let absfile = fromMaybe whoops $ absNormPath cwd file
-	return $ relPathDirToFile (parentDir absfile) 
-			(Git.workTree g) </> ".git" </> annexLocation key
-	where
-		whoops = error $ "unable to normalize " ++ file
-
-{- Updates the LocationLog when a key's presence changes in the current
- - repository. -}
-logStatus :: Key -> LogStatus -> Annex ()
-logStatus key status = do
-	g <- gitRepo
-	u <- getUUID g
-	logChange g key u status
-
-{- Runs an action, passing it a temporary filename to download,
- - and if the action succeeds, moves the temp file into 
- - the annex as a key's content. -}
-getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmp key action = do
-	g <- gitRepo
-	let tmp = gitAnnexTmpLocation g key
-
-	-- Check that there is enough free disk space.
-	-- When the temp file already exists, count the space
-	-- it is using as free.
-	e <- liftIO $ doesFileExist tmp
-	if e
-		then do
-			stat <- liftIO $ getFileStatus tmp
-			checkDiskSpace' (fromIntegral $ fileSize stat) key
-		else checkDiskSpace key
-
-	when e $ liftIO $ allowWrite tmp
-
-	getViaTmpUnchecked key action
-
-prepTmp :: Key -> Annex FilePath
-prepTmp key = do
-	g <- gitRepo
-	let tmp = gitAnnexTmpLocation g key
-	liftIO $ createDirectoryIfMissing True (parentDir tmp)
-	return tmp
-
-{- Like getViaTmp, but does not check that there is enough disk space
- - for the incoming key. For use when the key content is already on disk
- - and not being copied into place. -}
-getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
-getViaTmpUnchecked key action = do
-	tmp <- prepTmp key
-	success <- action tmp
-	if success
-		then do
-			moveAnnex key tmp
-			logStatus key InfoPresent
-			return True
-		else do
-			-- the tmp file is left behind, in case caller wants
-			-- to resume its transfer
-			return False
-
-{- Creates a temp file, runs an action on it, and cleans up the temp file. -}
-withTmp :: Key -> (FilePath -> Annex a) -> Annex a
-withTmp key action = do
-	tmp <- prepTmp key
-	res <- action tmp
-	liftIO $ whenM (doesFileExist tmp) $ liftIO $ removeFile tmp
-	return res
-
-{- Checks that there is disk space available to store a given key,
- - throwing an error if not. -}
-checkDiskSpace :: Key -> Annex ()
-checkDiskSpace = checkDiskSpace' 0
-
-checkDiskSpace' :: Integer -> Key -> Annex ()
-checkDiskSpace' adjustment key = do
-	g <- gitRepo
-	r <- getConfig g "diskreserve" ""
-	let reserve = fromMaybe megabyte $ readSize dataUnits r
-	stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
-	case (stats, keySize key) of
-		(Nothing, _) -> return ()
-		(_, Nothing) -> return ()
-		(Just (FileSystemStats { fsStatBytesAvailable = have }), Just need) ->
-			when (need + reserve > have + adjustment) $
-				needmorespace (need + reserve - have - adjustment)
-	where
-		megabyte :: Integer
-		megabyte = 1000000
-		needmorespace n = unlessM (Annex.getState Annex.force) $
-			error $ "not enough free space, need " ++ 
-				roughSize storageUnits True n ++
-				" more (use --force to override this check or adjust annex.diskreserve)"
-
-{- Moves a file into .git/annex/objects/
- -
- - What if the key there already has content? This could happen for
- - various reasons; perhaps the same content is being annexed again.
- - Perhaps there has been a hash collision generating the keys.
- -
- - The current strategy is to assume that in this case it's safe to delete
- - one of the two copies of the content; and the one already in the annex
- - is left there, assuming it's the original, canonical copy.
- -
- - I considered being more paranoid, and checking that both files had
- - the same content. Decided against it because A) users explicitly choose
- - a backend based on its hashing properties and so if they're dealing
- - with colliding files it's their own fault and B) adding such a check
- - would not catch all cases of colliding keys. For example, perhaps 
- - a remote has a key; if it's then added again with different content then
- - the overall system now has two different peices of content for that
- - key, and one of them will probably get deleted later. So, adding the
- - check here would only raise expectations that git-annex cannot truely
- - meet.
- -}
-moveAnnex :: Key -> FilePath -> Annex ()
-moveAnnex key src = do
-	g <- gitRepo
-	let dest = gitAnnexLocation g key
-	let dir = parentDir dest
-	e <- liftIO $ doesFileExist dest
-	if e
-		then liftIO $ removeFile src
-		else liftIO $ do
-			createDirectoryIfMissing True dir
-			allowWrite dir -- in case the directory already exists
-			renameFile src dest
-			preventWrite dest
-			preventWrite dir
-
-withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
-withObjectLoc key a = do
-	g <- gitRepo
-	let file = gitAnnexLocation g key
-	let dir = parentDir file
-	a (dir, file)
-
-{- Removes a key's file from .git/annex/objects/ -}
-removeAnnex :: Key -> Annex ()
-removeAnnex key = withObjectLoc key $ \(dir, file) -> liftIO $ do
-	allowWrite dir
-	removeFile file
-	removeDirectory dir
-
-{- Moves a key's file out of .git/annex/objects/ -}
-fromAnnex :: Key -> FilePath -> Annex ()
-fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
-	allowWrite dir
-	allowWrite file
-	renameFile file dest
-	removeDirectory dir
-
-{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and
- - returns the file it was moved to. -}
-moveBad :: Key -> Annex FilePath
-moveBad key = do
-	g <- gitRepo
-	let src = gitAnnexLocation g key
-	let dest = gitAnnexBadDir g </> takeFileName src
-	liftIO $ do
-		createDirectoryIfMissing True (parentDir dest)
-		allowWrite (parentDir src)
-		renameFile src dest
-		removeDirectory (parentDir src)
-	logStatus key InfoMissing
-	return dest
-
-{- List of keys whose content exists in .git/annex/objects/ -}
-getKeysPresent :: Annex [Key]
-getKeysPresent = do
-	g <- gitRepo
-	getKeysPresent' $ gitAnnexObjectDir g
-getKeysPresent' :: FilePath -> Annex [Key]
-getKeysPresent' dir = do
-	exists <- liftIO $ doesDirectoryExist dir
-	if not exists
-		then return []
-		else liftIO $ do
-			-- 2 levels of hashing
-			levela <- dirContents dir
-			levelb <- mapM dirContents levela
-			contents <- mapM dirContents (concat levelb)
-			let files = concat contents
-			return $ mapMaybe (fileKey . takeFileName) files
-
-{- Things to do to record changes to content. -}
-saveState :: Annex ()
-saveState = do
-	AnnexQueue.flush False
-	Branch.commit "update"