remotes lookup

This commit is contained in:
Joey Hess 2010-10-12 01:35:32 -04:00
parent 92bf408c66
commit eea55856e9

View file

@ -26,7 +26,7 @@ import System.Cmd.Utils
import System.IO import System.IO
import System.Posix.Process import System.Posix.Process
import Data.String.Utils import Data.String.Utils
import Data.Map as Map (fromList, empty, lookup, Map) import Data.Map as Map hiding (map, split)
import Network.URI import Network.URI
import Maybe import Maybe
import Utility import Utility
@ -61,14 +61,15 @@ gitRepoFromPath dir = do
- Throws exception on invalid url. -} - Throws exception on invalid url. -}
gitRepoFromUrl :: String -> IO GitRepo gitRepoFromUrl :: String -> IO GitRepo
gitRepoFromUrl url = do gitRepoFromUrl url = do
return RemoteGitRepo { return $ RemoteGitRepo {
url = url, url = url,
top = path url, top = path url,
config = Map.empty config = Map.empty
} }
where path url = uriPath $ fromJust $ parseURI url where path url = uriPath $ fromJust $ parseURI url
{- Some code needs to vary between remote and local repos. -} {- Some code needs to vary between remote and local repos, these functions
- help with that. -}
local repo = case (repo) of local repo = case (repo) of
LocalGitRepo {} -> True LocalGitRepo {} -> True
RemoteGitRepo {} -> False RemoteGitRepo {} -> False
@ -165,9 +166,19 @@ gitConfigParse s = Map.fromList $ map pair $ lines s
{- Returns a single git config setting, or a default value if not set. -} {- Returns a single git config setting, or a default value if not set. -}
gitConfig :: GitRepo -> String -> String -> String gitConfig :: GitRepo -> String -> String -> String
gitConfig repo key defaultValue = gitConfig repo key defaultValue =
case (Map.lookup key $ config repo) of Map.findWithDefault key defaultValue (config repo)
Just value -> value
Nothing -> defaultValue {- Returns a list of a repo's configured remotes. -}
gitConfigRemotes :: GitRepo -> IO [GitRepo]
gitConfigRemotes repo = mapM construct remotes
where
remotes = elems $ filter $ config repo
filter = filterWithKey (\k _ -> isremote k)
isremote k = (startswith "remote." k) && (endswith ".url" k)
construct r =
if (isURI r)
then gitRepoFromUrl r
else gitRepoFromPath r
{- Finds the current git repository, which may be in a parent directory. -} {- Finds the current git repository, which may be in a parent directory. -}
gitRepoCurrent :: IO GitRepo gitRepoCurrent :: IO GitRepo