diff options
Diffstat (limited to 'Git/Construct.hs')
| -rw-r--r-- | Git/Construct.hs | 73 |
1 files changed, 16 insertions, 57 deletions
diff --git a/Git/Construct.hs b/Git/Construct.hs index 586fa8c03..71a13f49f 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -23,12 +23,8 @@ module Git.Construct ( checkForRepo, ) where -{-# LANGUAGE CPP #-} - #ifndef mingw32_HOST_OS import System.Posix.User -#else -import Git.FilePath #endif import qualified Data.Map as M hiding (map, split) import Network.URI @@ -36,6 +32,7 @@ import Network.URI import Common import Git.Types import Git +import Git.Remote import qualified Git.Url as Url import Utility.UserInfo @@ -91,7 +88,7 @@ fromUrl url fromUrlStrict :: String -> IO Repo fromUrlStrict url - | startswith "file://" url = fromAbsPath $ uriPath u + | startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u | otherwise = newFrom $ Url u where u = fromMaybe bad $ parseURI url @@ -107,14 +104,16 @@ localToUrl :: Repo -> Repo -> Repo localToUrl reference r | not $ repoIsUrl reference = error "internal error; reference repo not url" | repoIsUrl r = r - | otherwise = r { location = Url $ fromJust $ parseURI absurl } - where - absurl = concat - [ Url.scheme reference - , "//" - , Url.authority reference - , repoPath r - ] + | otherwise = case Url.authority reference of + Nothing -> r + Just auth -> + let absurl = concat + [ Url.scheme reference + , "//" + , auth + , repoPath r + ] + in r { location = Url $ fromJust $ parseURI absurl } {- Calculates a list of a repo's configured remotes, by parsing its config. -} fromRemotes :: Repo -> IO [Repo] @@ -143,51 +142,10 @@ remoteNamedFromKey k = remoteNamed basename {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} fromRemoteLocation :: String -> Repo -> IO Repo -fromRemoteLocation s repo = gen $ calcloc s +fromRemoteLocation s repo = gen $ parseRemoteLocation s repo where - gen v -#ifdef mingw32_HOST_OS - | dosstyle v = fromRemotePath (dospath v) repo -#endif - | scpstyle v = fromUrl $ scptourl v - | urlstyle v = fromUrl v - | otherwise = fromRemotePath v repo - -- insteadof config can rewrite remote location - calcloc l - | null insteadofs = l - | otherwise = replacement ++ drop (length bestvalue) l - where - replacement = drop (length prefix) $ - take (length bestkey - length suffix) bestkey - (bestkey, bestvalue) = maximumBy longestvalue insteadofs - longestvalue (_, a) (_, b) = compare b a - insteadofs = filterconfig $ \(k, v) -> - startswith prefix k && - endswith suffix k && - startswith v l - filterconfig f = filter f $ - concatMap splitconfigs $ M.toList $ fullconfig repo - splitconfigs (k, vs) = map (\v -> (k, v)) vs - (prefix, suffix) = ("url." , ".insteadof") - urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v - -- git remotes can be written scp style -- [user@]host:dir - -- but foo::bar is a git-remote-helper location instead - scpstyle v = ":" `isInfixOf` v - && not ("//" `isInfixOf` v) - && not ("::" `isInfixOf` v) - scptourl v = "ssh://" ++ host ++ slash dir - where - (host, dir) = separate (== ':') v - slash d | d == "" = "/~/" ++ d - | "/" `isPrefixOf` d = d - | "~" `isPrefixOf` d = '/':d - | otherwise = "/~/" ++ d -#ifdef mingw32_HOST_OS - -- git on Windows will write a path to .git/config with "drive:", - -- which is not to be confused with a "host:" - dosstyle = hasDrive - dospath = fromInternalGitPath -#endif + gen (RemotePath p) = fromRemotePath p repo + gen (RemoteUrl u) = fromUrl u {- Constructs a Repo from the path specified in the git remotes of - another Repo. -} @@ -272,6 +230,7 @@ newFrom l = return Repo , remotes = [] , remoteName = Nothing , gitEnv = Nothing + , gitGlobalOpts = [] } |