summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-10 15:54:02 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-10 16:06:36 -0400
commitdce9c2e0804d2c94f46dcac8c9884766bb22dcc7 (patch)
tree0533ee4b599a6e1f83f31dd00f628ee866c91285
parent7880dc16fef81bb6a8812c6b4e9578a6ae2b2879 (diff)
convert GitRepo to struct with constructor
-rw-r--r--Annex.hs30
-rw-r--r--Backend.hs1
-rw-r--r--BackendFile.hs8
-rw-r--r--GitRepo.hs61
-rw-r--r--LocationLog.hs1
-rw-r--r--Locations.hs18
-rw-r--r--git-annex.hs2
7 files changed, 71 insertions, 50 deletions
diff --git a/Annex.hs b/Annex.hs
index bd9ce92a4..f23358bf6 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 40279866f..e01f12239 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 6caf30f65..92f708696 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 690782f0d..fda83f7d8 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 32af82461..73e9f1c6d 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 000000000..7273797ef
--- /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 cce49050b..f8c67b1fd 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"