fix remote vs remote wording confusion

This commit is contained in:
Joey Hess 2010-10-22 14:05:30 -04:00
parent 897bf49b4e
commit 46ac66a438

View file

@ -10,8 +10,7 @@ module GitRepo (
repoFromCwd, repoFromCwd,
repoFromPath, repoFromPath,
repoFromUrl, repoFromUrl,
repoIsLocal, repoIsUrl,
repoIsRemote,
repoIsSsh, repoIsSsh,
repoDescribe, repoDescribe,
workTree, workTree,
@ -46,17 +45,16 @@ import Maybe
import Utility import Utility
{- A git repository can be on local disk or remote. Not to be confused {- There are two types of repositories; those on local disk and those
- with a git repo's configured remotes, some of which may be on local - accessed via an URL. -}
- disk. -}
data Repo = data Repo =
LocalRepo { Repo {
top :: FilePath, top :: FilePath,
config :: Map String String, config :: Map String String,
remotes :: [Repo], remotes :: [Repo],
-- remoteName holds the name used for this repo in remotes -- remoteName holds the name used for this repo in remotes
remoteName :: Maybe String remoteName :: Maybe String
} | RemoteRepo { } | UrlRepo {
url :: URI, url :: URI,
config :: Map String String, config :: Map String String,
remotes :: [Repo], remotes :: [Repo],
@ -66,7 +64,7 @@ data Repo =
{- Local Repo constructor. -} {- Local Repo constructor. -}
repoFromPath :: FilePath -> Repo repoFromPath :: FilePath -> Repo
repoFromPath dir = repoFromPath dir =
LocalRepo { Repo {
top = dir, top = dir,
config = Map.empty, config = Map.empty,
remotes = [], remotes = [],
@ -76,7 +74,7 @@ repoFromPath dir =
{- Remote Repo constructor. Throws exception on invalid url. -} {- Remote Repo constructor. Throws exception on invalid url. -}
repoFromUrl :: String -> Repo repoFromUrl :: String -> Repo
repoFromUrl url = repoFromUrl url =
RemoteRepo { UrlRepo {
url = fromJust $ parseURI url, url = fromJust $ parseURI url,
config = Map.empty, config = Map.empty,
remotes = [], remotes = [],
@ -87,7 +85,7 @@ repoFromUrl url =
repoDescribe repo = repoDescribe repo =
if (isJust $ remoteName repo) if (isJust $ remoteName repo)
then fromJust $ remoteName repo then fromJust $ remoteName repo
else if (repoIsLocal repo) else if (not $ repoIsUrl repo)
then top repo then top repo
else show (url repo) else show (url repo)
@ -103,20 +101,19 @@ repoRemoteName r =
then fromJust $ remoteName r then fromJust $ remoteName r
else "" else ""
{- Some code needs to vary between remote and local repos, {- Some code needs to vary between URL and normal repos,
- or bare and non-bare, these functions help with that. -} - or bare and non-bare, these functions help with that. -}
repoIsLocal repo = case (repo) of repoIsUrl repo = case (repo) of
LocalRepo {} -> True UrlRepo {} -> True
RemoteRepo {} -> False Repo {} -> False
repoIsRemote repo = not $ repoIsLocal repo repoIsSsh repo = repoIsUrl repo && (uriScheme $ url repo) == "ssh:"
repoIsSsh repo = repoIsRemote repo && (uriScheme $ url repo) == "ssh:" assertLocal repo action =
assertlocal repo action = if (not $ repoIsUrl repo)
if (repoIsLocal repo)
then action then action
else error $ "acting on remote git repo " ++ (repoDescribe repo) ++ else error $ "acting on remote git repo " ++ (repoDescribe repo) ++
" not supported" " not supported"
assertremote repo action = assertUrl repo action =
if (repoIsRemote repo) if (repoIsUrl repo)
then action then action
else error $ "acting on local git repo " ++ (repoDescribe repo) ++ else error $ "acting on local git repo " ++ (repoDescribe repo) ++
" not supported" " not supported"
@ -135,7 +132,7 @@ bare repo =
{- Path to a repository's gitattributes file. -} {- Path to a repository's gitattributes file. -}
attributes :: Repo -> String attributes :: Repo -> String
attributes repo = assertlocal repo $ do attributes repo = assertLocal repo $ do
if (bare repo) if (bare repo)
then (top repo) ++ "/info/.gitattributes" then (top repo) ++ "/info/.gitattributes"
else (top repo) ++ "/.gitattributes" else (top repo) ++ "/.gitattributes"
@ -147,13 +144,13 @@ dir repo = if (bare repo) then "" else ".git"
{- Path to a repository's --work-tree. -} {- Path to a repository's --work-tree. -}
workTree :: Repo -> FilePath workTree :: Repo -> FilePath
workTree repo = workTree repo =
if (repoIsLocal) repo if (not $ repoIsUrl repo)
then top repo then top repo
else assertssh repo $ (remoteHost repo) ++ ":" ++ (uriPath $ url repo) else assertssh repo $ (remoteHost repo) ++ ":" ++ (uriPath $ url repo)
{- Hostname for a remote repo. (May include a username and/or port too.) -} {- Hostname for a remote repo. (May include a username and/or port too.) -}
remoteHost :: Repo -> String remoteHost :: Repo -> String
remoteHost repo = assertremote repo $ remoteHost repo = assertUrl repo $
(uriUserInfo a) ++ (uriRegName a) ++ (uriPort a) (uriUserInfo a) ++ (uriRegName a) ++ (uriPort a)
where where
a = fromJust $ uriAuthority $ url repo a = fromJust $ uriAuthority $ url repo
@ -175,19 +172,19 @@ relative repo file = drop (length absrepo) absfile
{- Constructs a git command line operating on the specified repo. -} {- Constructs a git command line operating on the specified repo. -}
gitCommandLine :: Repo -> [String] -> [String] gitCommandLine :: Repo -> [String] -> [String]
gitCommandLine repo params = assertlocal repo $ gitCommandLine repo params = assertLocal repo $
-- force use of specified repo via --git-dir and --work-tree -- force use of specified repo via --git-dir and --work-tree
["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params ["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params
{- Runs git in the specified repo. -} {- Runs git in the specified repo. -}
run :: Repo -> [String] -> IO () run :: Repo -> [String] -> IO ()
run repo params = assertlocal repo $ do run repo params = assertLocal repo $ do
r <- safeSystem "git" (gitCommandLine repo params) r <- safeSystem "git" (gitCommandLine repo params)
return () return ()
{- Runs a git subcommand and returns its output. -} {- Runs a git subcommand and returns its output. -}
pipeRead :: Repo -> [String] -> IO String pipeRead :: Repo -> [String] -> IO String
pipeRead repo params = assertlocal repo $ do pipeRead repo params = assertLocal repo $ do
pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do
ret <- hGetContentsStrict h ret <- hGetContentsStrict h
return ret return ret
@ -208,10 +205,11 @@ notInRepo repo location = do
{- Runs git config and populates a repo with its config. -} {- Runs git config and populates a repo with its config. -}
configRead :: Repo -> IO Repo configRead :: Repo -> IO Repo
configRead repo = if (repoIsLocal repo) configRead repo =
if (not $ repoIsUrl repo)
then do
{- Cannot use pipeRead because it relies on the config having {- Cannot use pipeRead because it relies on the config having
been already read. Instead, chdir to the repo. -} been already read. Instead, chdir to the repo. -}
then do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
bracket_ (changeWorkingDirectory (top repo)) bracket_ (changeWorkingDirectory (top repo))
(\_ -> changeWorkingDirectory cwd) $ (\_ -> changeWorkingDirectory cwd) $