got rid of Core module

Most of it was to do with managing annexed Content, so put there

1 files changed, 0 insertions, 210 deletions

diff --git a/Core.hs b/Core.hs
deleted file mode 100644
index d59120d67..000000000
--- a/Core.hs
+++ /dev/null
@@ -1,210 +0,0 @@
-{- git-annex core functions
- -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Core where
-
-import System.IO.Error (try)
-import System.Directory
-import Control.Monad.State (liftIO)
-import System.Path
-import Control.Monad (when, unless, filterM)
-import System.Posix.Files
-import Data.Maybe
-import System.FilePath
-
-import Types
-import Locations
-import LocationLog
-import UUID
-import qualified GitRepo as Git
-import qualified GitQueue
-import qualified Annex
-import qualified Backend
-import Utility
-import Messages
-
-{- Runs a list of Annex actions. Catches IO errors and continues
- - (but explicitly thrown errors terminate the whole command).
- - Runs shutdown and propigates an overall error status at the end.
- -}
-tryRun :: AnnexState -> [Annex Bool] -> IO ()
-tryRun state actions = tryRun' state 0 actions
-tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
-tryRun' state errnum (a:as) = do
-	result <- try $ Annex.run state a
-	case result of
-		Left err -> do
-			Annex.eval state $ showErr err
-			tryRun' state (errnum + 1) as
-		Right (True,state') -> tryRun' state' errnum as
-		Right (False,state') -> tryRun' state' (errnum + 1) as
-tryRun' state errnum [] = do
-	_ <- try $ Annex.run state $ shutdown errnum
-	when (errnum > 0) $ error $ show errnum ++ " failed"
-
-{- Actions to perform each time ran. -}
-startup :: Annex Bool
-startup = do
-	prepUUID
-	return True
-
-{- When git-annex is done, it runs this. -}
-shutdown :: Integer -> Annex Bool
-shutdown errnum = do
-	q <- Annex.queueGet
-	unless (q == GitQueue.empty) $ do
-		showSideAction "Recording state in git..."
-		Annex.queueRun
-
-	-- If nothing failed, clean up any files left in the temp directory,
-	-- but leave the directory itself. If something failed, temp files
-	-- are left behind to allow resuming on re-run.
-	when (errnum == 0) $ do
-		g <- Annex.gitRepo
-		let tmp = annexTmpLocation g
-		exists <- liftIO $ doesDirectoryExist tmp
-		when exists $ liftIO $ removeDirectoryRecursive tmp
-		liftIO $ createDirectoryIfMissing True tmp
-
-	return True
-
-{- Checks if a given key is currently present in the annexLocation. -}
-inAnnex :: Key -> Annex Bool
-inAnnex key = do
-	g <- Annex.gitRepo
-	when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
-	liftIO $ doesFileExist $ annexLocation 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 <- Annex.gitRepo
-	cwd <- liftIO $ getCurrentDirectory
-	let absfile = case absNormPath cwd file of
-		Just f -> f
-		Nothing -> error $ "unable to normalize " ++ file
-	return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++
-		annexLocationRelative key
-
-{- Updates the LocationLog when a key's presence changes. -}
-logStatus :: Key -> LogStatus -> Annex ()
-logStatus key status = do
-	g <- Annex.gitRepo
-	u <- getUUID g
-	logfile <- liftIO $ logChange g key u status
-	Annex.queue "add" ["--"] logfile
-
-{- 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 <- Annex.gitRepo
-	let tmp = annexTmpLocation g ++ keyFile key
-	liftIO $ createDirectoryIfMissing True (parentDir tmp)
-	success <- action tmp
-	if success
-		then do
-			moveAnnex key tmp
-			logStatus key ValuePresent
-			return True
-		else do
-			-- the tmp file is left behind, in case caller wants
-			-- to resume its transfer
-			return False
-
-{- Removes the write bits from a file. -}
-preventWrite :: FilePath -> IO ()
-preventWrite f = unsetFileMode f writebits
-	where
-		writebits = foldl unionFileModes ownerWriteMode
-					[groupWriteMode, otherWriteMode]
-
-{- Turns a file's write bit back on. -}
-allowWrite :: FilePath -> IO ()
-allowWrite f = do
-	s <- getFileStatus f
-	setFileMode f $ fileMode s `unionFileModes` ownerWriteMode
-
-{- Moves a file into .git/annex/objects/ -}
-moveAnnex :: Key -> FilePath -> Annex ()
-moveAnnex key src = do
-	g <- Annex.gitRepo
-	let dest = annexLocation g key
-	let dir = parentDir dest
-	liftIO $ do
-		createDirectoryIfMissing True dir
-		allowWrite dir -- in case the directory already exists
-		renameFile src dest
-		preventWrite dest
-		preventWrite dir
-
-{- Removes a key's file from .git/annex/objects/ -}
-removeAnnex :: Key -> Annex ()
-removeAnnex key = do
-	g <- Annex.gitRepo
-	let file = annexLocation g key
-	let dir = parentDir 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 = do
-	g <- Annex.gitRepo
-	let file = annexLocation g key
-	let dir = parentDir 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 <- Annex.gitRepo
-	let src = annexLocation g key
-	let dest = annexBadLocation g ++ takeFileName src
-	liftIO $ createDirectoryIfMissing True (parentDir dest)
-	liftIO $ allowWrite (parentDir src)
-	liftIO $ renameFile src dest
-	liftIO $ removeDirectory (parentDir src)
-	return dest
-
-{- List of keys whose content exists in .git/annex/objects/ -}
-getKeysPresent :: Annex [Key]
-getKeysPresent = do
-	g <- Annex.gitRepo
-	getKeysPresent' $ annexObjectDir g
-getKeysPresent' :: FilePath -> Annex [Key]
-getKeysPresent' dir = do
-	exists <- liftIO $ doesDirectoryExist dir
-	if (not exists)
-		then return []
-		else do
-			contents <- liftIO $ getDirectoryContents dir
-			files <- liftIO $ filterM present contents
-			return $ map fileKey files
-	where
-		present d = do
-			result <- try $
-				getFileStatus $ dir ++ "/" ++ d ++ "/"  ++ takeFileName d
-			case result of
-				Right s -> return $ isRegularFile s
-				Left _ -> return False
-
-{- List of keys referenced by symlinks in the git repo. -}
-getKeysReferenced :: Annex [Key]
-getKeysReferenced = do
-	g <- Annex.gitRepo
-	files <- liftIO $ Git.inRepo g [Git.workTree g]
-	keypairs <- mapM Backend.lookupFile files
-	return $ map fst $ catMaybes keypairs