From dce9c2e0804d2c94f46dcac8c9884766bb22dcc7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 10 Oct 2010 15:54:02 -0400 Subject: [PATCH] convert GitRepo to struct with constructor --- Annex.hs | 30 +++++++++++++++++++------ Backend.hs | 1 + BackendFile.hs | 8 ++++--- GitRepo.hs | 61 ++++++++++++++++++-------------------------------- LocationLog.hs | 1 + Locations.hs | 18 +++++++++++++++ git-annex.hs | 2 +- 7 files changed, 71 insertions(+), 50 deletions(-) create mode 100644 Locations.hs diff --git a/Annex.hs b/Annex.hs index bd9ce92a4e..f23358bf63 100644 --- a/Annex.hs +++ b/Annex.hs @@ -3,16 +3,12 @@ module Annex where -import Backend import System.Posix.Files import System.Directory import GitRepo import Utility - -{- An annexed file's content is stored somewhere under .git/annex/ -} -annexLoc repo key = do - dir <- gitDir repo - return $ dir ++ "/annex/" ++ key +import Locations +import Backend {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} @@ -28,8 +24,28 @@ annexFile backends repo file = do Just key -> symlink key where symlink key = do - dest <- annexLoc repo key + dest <- annexDir repo key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file gitAdd repo file + +{- Sets up a git repo for git-annex. May be called repeatedly. -} +gitPrep :: GitRepo -> IO () +gitPrep repo = do + -- configure git to use union merge driver on state files + let attrLine = stateLoc ++ "/* merge=union" + attributes <- gitAttributes repo + exists <- doesFileExist attributes + if (not exists) + then do + writeFile attributes $ attrLine ++ "\n" + gitAdd repo attributes + else do + content <- readFile attributes + if (all (/= attrLine) (lines content)) + then do + appendFile attributes $ attrLine ++ "\n" + gitAdd repo attributes + else return () + diff --git a/Backend.hs b/Backend.hs index 40279866fd..e01f122395 100644 --- a/Backend.hs +++ b/Backend.hs @@ -19,6 +19,7 @@ module Backend where import System.Directory +import Locations import GitRepo import Utility diff --git a/BackendFile.hs b/BackendFile.hs index 6caf30f65d..92f708696b 100644 --- a/BackendFile.hs +++ b/BackendFile.hs @@ -17,11 +17,13 @@ backend = Backend { keyValue :: GitRepo -> FilePath -> IO (Maybe Key) keyValue repo file = return $ Just file --- This backend does not really do any independant data storage, --- it relies on the file contents in .git/annex/ in this repo, --- and other accessible repos. So storing a file is a no-op. +{- This backend does not really do any independant data storage, + - it relies on the file contents in .git/annex/ in this repo, + - and other accessible repos. So storing a file is a no-op. -} dummyStore :: GitRepo -> FilePath -> Key -> IO (Bool) dummyStore repo file key = return True +{- Try to find a copy of the file in one of the other repos, + - and copy it over to this one. -} copyFromOtherRepo :: IO Key -> FilePath -> IO (Bool) copyFromOtherRepo key file = error "copyFromOtherRepo unimplemented" -- TODO diff --git a/GitRepo.hs b/GitRepo.hs index 690782f0dc..fda83f7d8e 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -8,79 +8,62 @@ import System.Path import Data.String.Utils import Utility -type GitRepo = FilePath +data GitRepo = GitRepo { + top :: FilePath, + remotes :: [GitRepo] +} deriving (Eq, Show, Read) -{- Long-term state is stored in files inside the .git-annex directory - - in the git repository. -} -stateLoc = ".git-annex" -gitStateDir :: GitRepo -> FilePath -gitStateDir repo = repo ++ "/" ++ stateLoc ++ "/" +{- GitRepo constructor -} +gitRepo :: FilePath -> IO GitRepo +gitRepo dir = do + -- TOOD query repo for configuration settings; other repositories; etc + return GitRepo { top = dir, remotes = [] } {- Path to a repository's gitattributes file. -} gitAttributes :: GitRepo -> IO String gitAttributes repo = do - bare <- isBareRepo repo + bare <- isBareRepo (top repo) if (bare) - then return $ repo ++ "/info/.gitattributes" - else return $ repo ++ "/.gitattributes" + then return $ (top repo) ++ "/info/.gitattributes" + else return $ (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} gitDir :: GitRepo -> IO String gitDir repo = do - bare <- isBareRepo repo + bare <- isBareRepo (top repo) if (bare) - then return $ repo - else return $ repo ++ "/.git" + then return $ (top repo) + else return $ (top repo) ++ "/.git" {- Given a relative or absolute filename, calculates the name to use - - relative to a git repository directory (which must be absolute). + - to refer to the file relative to a git repository directory. - This is the same form displayed and used by git. -} gitRelative :: GitRepo -> String -> String gitRelative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file - absrepo = case (absNormPath "/" repo) of + absrepo = case (absNormPath "/" (top repo)) of Just f -> f ++ "/" - Nothing -> error $ "bad repo" ++ repo + Nothing -> error $ "bad repo" ++ (top repo) absfile = case (secureAbsNormPath absrepo file) of Just f -> f Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo -{- Sets up a git repo for git-annex. May be called repeatedly. -} -gitPrep :: GitRepo -> IO () -gitPrep repo = do - -- configure git to use union merge driver on state files - let attrLine = stateLoc ++ "/* merge=union" - attributes <- gitAttributes repo - exists <- doesFileExist attributes - if (not exists) - then do - writeFile attributes $ attrLine ++ "\n" - gitAdd repo attributes - else do - content <- readFile attributes - if (all (/= attrLine) (lines content)) - then do - appendFile attributes $ attrLine ++ "\n" - gitAdd repo attributes - else return () - {- Stages a changed file in git's index. -} gitAdd repo file = do -- TODO return () -{- Finds the top of the current git repository, which may be in a parent - - directory. -} -repoTop :: IO GitRepo -repoTop = do +{- Finds the current git repository, which may be in a parent directory. -} +currentRepo :: IO GitRepo +currentRepo = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> return dir + (Just dir) -> gitRepo dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) diff --git a/LocationLog.hs b/LocationLog.hs index 32af824612..73e9f1c6d0 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -25,6 +25,7 @@ import System.Directory import Data.Char import GitRepo import Utility +import Locations data LogStatus = FilePresent | FileMissing | Undefined deriving (Eq) diff --git a/Locations.hs b/Locations.hs new file mode 100644 index 0000000000..7273797ef9 --- /dev/null +++ b/Locations.hs @@ -0,0 +1,18 @@ +{- git-annex file locations + -} + +module Locations where + +import GitRepo + +{- An annexed file's content is stored somewhere under .git/annex/ -} +annexDir :: GitRepo -> String -> IO FilePath +annexDir repo key = do + dir <- gitDir repo + return $ dir ++ "/annex/" ++ key + +{- Long-term state is stored in files inside the .git-annex directory + - in the git repository. -} +stateLoc = ".git-annex" +gitStateDir :: GitRepo -> FilePath +gitStateDir repo = (top repo) ++ "/" ++ stateLoc ++ "/" diff --git a/git-annex.hs b/git-annex.hs index cce49050b3..f8c67b1fdd 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -13,7 +13,7 @@ import qualified BackendUrl backends = [BackendFile.backend, BackendChecksum.backend, BackendUrl.backend] main = do - repo <- repoTop + repo <- currentRepo gitPrep repo l <- readLog "demo.log"