summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex.hs2
-rw-r--r--GitRepo.hs101
-rw-r--r--Locations.hs4
3 files changed, 73 insertions, 34 deletions
diff --git a/Annex.hs b/Annex.hs
index abb7bff6e..5a7274ca1 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -86,7 +86,7 @@ gitPrep :: GitRepo -> IO ()
gitPrep repo = do
-- configure git to use union merge driver on state files
let attrLine = stateLoc ++ "/*.log merge=union"
- attributes <- gitAttributes repo
+ let attributes = gitAttributes repo
exists <- doesFileExist attributes
if (not exists)
then do
diff --git a/GitRepo.hs b/GitRepo.hs
index 2a97e6070..dc1c52b47 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -7,9 +7,10 @@
module GitRepo (
GitRepo,
- gitRepoFromPath,
gitRepoCurrent,
- gitRepoTop,
+ gitRepoFromPath,
+ gitRepoFromUrl,
+ gitWorkTree,
gitDir,
gitRelative,
gitConfig,
@@ -26,21 +27,28 @@ import System.IO
import System.Posix.Process
import Data.String.Utils
import Data.Map as Map (fromList, empty, lookup, Map)
+import Network.URI
+import Maybe
import Utility
--- a git repository
-data GitRepo = GitRepo {
- top :: FilePath,
- bare :: Bool,
- config :: Map String String
-} deriving (Show, Read, Eq)
-
-{- GitRepo constructor -}
+{- A git repository can be local or remote. -}
+data GitRepo =
+ LocalGitRepo {
+ top :: FilePath,
+ bare :: Bool,
+ config :: Map String String
+ } | RemoteGitRepo {
+ url :: String,
+ top :: FilePath,
+ config :: Map String String
+ } deriving (Show, Read, Eq)
+
+{- Local GitRepo constructor. -}
gitRepoFromPath :: FilePath -> IO GitRepo
gitRepoFromPath dir = do
b <- isBareRepo dir
- let r = GitRepo {
+ let r = LocalGitRepo {
top = dir,
bare = b,
config = Map.empty
@@ -49,28 +57,49 @@ gitRepoFromPath dir = do
return r'
-{- Field accessor. -}
-gitRepoTop :: GitRepo -> FilePath
-gitRepoTop repo = top repo
+{- Remote GitRepo constructor. Note that remote repo config is not read.
+ - Throws exception on invalid url. -}
+gitRepoFromUrl :: String -> IO GitRepo
+gitRepoFromUrl url = do
+ return RemoteGitRepo {
+ url = url,
+ top = path url,
+ config = Map.empty
+ }
+ where path url = uriPath $ fromJust $ parseURI url
+
+{- Some code needs to vary between remote and local repos. -}
+local repo = case (repo) of
+ LocalGitRepo {} -> True
+ RemoteGitRepo {} -> False
+remote repo = not $ local repo
+assertlocal repo action =
+ if (local repo)
+ then action
+ else error "acting on remote git repo not supported"
{- Path to a repository's gitattributes file. -}
-gitAttributes :: GitRepo -> IO String
-gitAttributes repo = do
+gitAttributes :: GitRepo -> String
+gitAttributes repo = assertlocal repo $ do
if (bare repo)
- then return $ (top repo) ++ "/info/.gitattributes"
- else return $ (top repo) ++ "/.gitattributes"
+ then (top repo) ++ "/info/.gitattributes"
+ else (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 -> String
-gitDir repo =
+gitDir repo = assertlocal repo $
if (bare repo)
then top repo
else top repo ++ "/.git"
-{- Given a relative or absolute filename, calculates the name to use
- - to refer to the file relative to a git repository directory.
+{- Path to a repository's --work-tree. -}
+gitWorkTree :: GitRepo -> FilePath
+gitWorkTree repo = top repo
+
+{- Given a relative or absolute filename in a repository, calculates the
+ - name to use to refer to the file relative to a git repository's top.
- This is the same form displayed and used by git. -}
gitRelative :: GitRepo -> String -> String
gitRelative repo file = drop (length absrepo) absfile
@@ -92,26 +121,36 @@ gitAdd repo file = runGit repo ["add", file]
gitCommandLine :: GitRepo -> [String] -> [String]
gitCommandLine repo params =
-- force use of specified repo via --git-dir and --work-tree
- ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params
+ if (local repo)
+ then ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params
+ else error "gitCommandLine not implemented for remote repo"
{- Runs git in the specified repo. -}
runGit :: GitRepo -> [String] -> IO ()
-runGit repo params = do
- r <- executeFile "git" True (gitCommandLine repo params) Nothing
- return ()
+runGit repo params =
+ if (local repo)
+ then do
+ r <- executeFile "git" True (gitCommandLine repo params) Nothing
+ return ()
+ else error "runGit not implemented for remote repo"
{- Runs a git subcommand and returns its output. -}
gitPipeRead :: GitRepo -> [String] -> IO String
gitPipeRead repo params =
- pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do
- ret <- hGetContentsStrict h
- return ret
+ if (local repo)
+ then pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do
+ ret <- hGetContentsStrict h
+ return ret
+ else error "gitPipeRead not implemented for remote repo"
{- Runs git config and populates a repo with its settings. -}
gitConfigRead :: GitRepo -> IO GitRepo
-gitConfigRead repo = do
- c <- gitPipeRead repo ["config", "--list"]
- return repo { config = gitConfigParse c }
+gitConfigRead repo =
+ if (local repo)
+ then do
+ c <- gitPipeRead repo ["config", "--list"]
+ return repo { config = gitConfigParse c }
+ else error "gitConfigRead not implemented for remote repo"
{- Parses git config --list output into a config map. -}
gitConfigParse :: String -> Map.Map String String
diff --git a/Locations.hs b/Locations.hs
index 31bb3d9de..300f443f7 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -9,7 +9,7 @@ module Locations (
import GitRepo
{- Long-term, cross-repo state is stored in files inside the .git-annex
- - directory, in the git repository. -}
+ - directory, in the git repository's working tree. -}
stateLoc = ".git-annex"
gitStateDir :: GitRepo -> FilePath
-gitStateDir repo = (gitRepoTop repo) ++ "/" ++ stateLoc ++ "/"
+gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"