diff options
| author |  Joey Hess <joey@kitenet.net> | 2011-12-14 15:30:14 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2011-12-14 15:43:13 -0400 |
| commit | 02f1bd2bf47d3ff49a222e9428ec27708ef55f64 (patch) | |
| tree | 456548530c65850a829a1a85609070bc111de1b9 /Git/Construct.hs | |
| parent | 2b24e16a633575703a43e1fb991f34b290a1d7e4 (diff) | |
split more stuff out of Git.hs
Diffstat (limited to 'Git/Construct.hs')
| -rw-r--r-- | Git/Construct.hs | 27 |
1 files changed, 22 insertions, 5 deletions
diff --git a/Git/Construct.hs b/Git/Construct.hs index 9149ab9ec..a35a87cc7 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -11,6 +11,8 @@ module Git.Construct ( fromUrl, fromUnknown, localToUrl, + remoteNamed, + remoteNamedFromKey, fromRemotes, fromRemoteLocation, repoAbsPath, @@ -23,6 +25,7 @@ import Network.URI import Common import Git.Types import Git +import qualified Git.Url as Url {- Finds the current git repository, which may be in a parent directory. -} fromCwd :: IO Repo @@ -67,8 +70,8 @@ fromUrl url bad = error $ "bad url " ++ url {- Creates a repo that has an unknown location. -} -fromUnknown :: Repo -fromUnknown = newFrom Unknown +fromUnknown :: IO Repo +fromUnknown = return $ newFrom Unknown {- Converts a local Repo into a remote repo, using the reference repo - which is assumed to be on the same host. -} @@ -79,8 +82,8 @@ localToUrl reference r | otherwise = r { location = Url $ fromJust $ parseURI absurl } where absurl = - urlScheme reference ++ "//" ++ - urlAuthority reference ++ + Url.scheme reference ++ "//" ++ + Url.authority reference ++ workTree r {- Calculates a list of a repo's configured remotes, by parsing its config. -} @@ -91,7 +94,21 @@ fromRemotes repo = mapM construct remotepairs filterkeys f = filterconfig (\(k,_) -> f k) remotepairs = filterkeys isremote isremote k = startswith "remote." k && endswith ".url" k - construct (k,v) = repoRemoteNameFromKey k <$> fromRemoteLocation v repo + construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo + +{- Sets the name of a remote when constructing the Repo to represent it. -} +remoteNamed :: String -> IO Repo -> IO Repo +remoteNamed n constructor = do + r <- constructor + return $ r { remoteName = Just n } + +{- Sets the name of a remote based on the git config key, such as + "remote.foo.url". -} +remoteNamedFromKey :: String -> IO Repo -> IO Repo +remoteNamedFromKey k = remoteNamed basename + where + basename = join "." $ reverse $ drop 1 $ + reverse $ drop 1 $ split "." k {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} |