add remoteName

This commit is contained in:
Joey Hess 2010-10-13 14:01:17 -04:00
parent 1dbf36bf9a
commit 794d44cf1d

View file

@ -40,11 +40,14 @@ import Utility
data GitRepo = data GitRepo =
LocalGitRepo { LocalGitRepo {
top :: FilePath, top :: FilePath,
config :: Map String String config :: Map String String,
-- remoteName holds the name used for this repo in remotes
remoteName :: Maybe String
} | RemoteGitRepo { } | RemoteGitRepo {
url :: String, url :: String,
top :: FilePath, top :: FilePath,
config :: Map String String config :: Map String String,
remoteName :: Maybe String
} deriving (Show, Read, Eq) } deriving (Show, Read, Eq)
{- Local GitRepo constructor. Can optionally query the repo for its config. -} {- Local GitRepo constructor. Can optionally query the repo for its config. -}
@ -52,7 +55,8 @@ gitRepoFromPath :: FilePath -> Bool -> IO GitRepo
gitRepoFromPath dir query = do gitRepoFromPath dir query = do
let r = LocalGitRepo { let r = LocalGitRepo {
top = dir, top = dir,
config = Map.empty config = Map.empty,
remoteName = Nothing
} }
if (query) if (query)
then gitConfigRead r then gitConfigRead r
@ -64,7 +68,8 @@ gitRepoFromUrl url query = do
return $ RemoteGitRepo { return $ RemoteGitRepo {
url = url, url = url,
top = path url, top = path url,
config = Map.empty config = Map.empty,
remoteName = Nothing
} }
where path url = uriPath $ fromJust $ parseURI url where path url = uriPath $ fromJust $ parseURI url
@ -174,13 +179,15 @@ gitConfig repo key defaultValue =
gitConfigRemotes :: GitRepo -> IO [GitRepo] gitConfigRemotes :: GitRepo -> IO [GitRepo]
gitConfigRemotes repo = mapM construct remotes gitConfigRemotes repo = mapM construct remotes
where where
remotes = elems $ filter $ config repo remotes = toList $ filter $ config repo
filter = filterWithKey (\k _ -> isremote k) filter = filterWithKey (\k _ -> isremote k)
isremote k = (startswith "remote." k) && (endswith ".url" k) isremote k = (startswith "remote." k) && (endswith ".url" k)
construct r = remotename k = (split "." k) !! 1
if (isURI r) construct (k,v) = do
then gitRepoFromUrl r False r <- if (isURI v)
else gitRepoFromPath r False then gitRepoFromUrl v False
else gitRepoFromPath v False
return r { remoteName = Just $ remotename k }
{- Finds the current git repository, which may be in a parent directory. -} {- Finds the current git repository, which may be in a parent directory. -}
gitRepoFromCwd :: IO GitRepo gitRepoFromCwd :: IO GitRepo