split more stuff out of Git.hs

1 files changed, 10 insertions, 138 deletions

diff --git a/Git.hs b/Git.hs
index b4cbd91aa..a3f2ad74c 100644
--- a/Git.hs
+++ b/Git.hs
@@ -9,7 +9,7 @@
  -}
 
 module Git (
-	Repo,
+	Repo(..),
 	Ref(..),
 	Branch,
 	Sha,
@@ -22,13 +22,6 @@ module Git (
 	repoLocation,
 	workTree,
 	gitDir,
-	urlPath,
-	urlHost,
-	urlPort,
-	urlHostUser,
-	urlAuthority,
-	urlScheme,
-	configMap,
 	configTrue,
 	gitCommandLine,
 	run,
@@ -39,23 +32,14 @@ module Git (
 	pipeNullSplit,
 	pipeNullSplitB,
 	attributes,
-	remotes,
-	remotesAdd,
-	repoRemoteName,
-	repoRemoteNameSet,
-	repoRemoteNameFromKey,
 	reap,
-	useIndex,
-	getSha,
-	shaSize,
 	assertLocal,
 ) where
 
 import qualified Data.Map as M
-import Network.URI
 import Data.Char
-import System.Posix.Env (setEnv, unsetEnv, getEnv)
 import qualified Data.ByteString.Lazy.Char8 as L
+import Network.URI (uriPath, uriScheme)
 
 import Common
 import Git.Types
@@ -73,29 +57,6 @@ repoLocation Repo { location = Url url } = show url
 repoLocation Repo { location = Dir dir } = dir
 repoLocation Repo { location = Unknown } = undefined
 
-{- Constructs and returns an updated version of a repo with
- - different remotes list. -}
-remotesAdd :: Repo -> [Repo] -> Repo
-remotesAdd repo rs = repo { remotes = rs }
-
-{- Returns the name of the remote that corresponds to the repo, if
- - it is a remote. -}
-repoRemoteName :: Repo -> Maybe String
-repoRemoteName Repo { remoteName = Just name } = Just name
-repoRemoteName _ = Nothing
-
-{- Sets the name of a remote. -}
-repoRemoteNameSet :: String -> Repo -> Repo
-repoRemoteNameSet n r = r { remoteName = Just n }
-
-{- Sets the name of a remote based on the git config key, such as
-   "remote.foo.url". -}
-repoRemoteNameFromKey :: String -> Repo -> Repo
-repoRemoteNameFromKey k = repoRemoteNameSet basename
-	where
-		basename = join "." $ reverse $ drop 1 $
-				reverse $ drop 1 $ split "." k
-
 {- Some code needs to vary between URL and normal repos,
  - or bare and non-bare, these functions help with that. -}
 repoIsUrl :: Repo -> Bool
@@ -104,11 +65,13 @@ repoIsUrl _ = False
 
 repoIsSsh :: Repo -> Bool
 repoIsSsh Repo { location = Url url } 
-	| uriScheme url == "ssh:" = True
+	| scheme == "ssh:" = True
 	-- git treats these the same as ssh
-	| uriScheme url == "git+ssh:" = True
-	| uriScheme url == "ssh+git:" = True
+	| scheme == "git+ssh:" = True
+	| scheme == "ssh+git:" = True
 	| otherwise = False
+	where
+		scheme = uriScheme url
 repoIsSsh _ = False
 
 repoIsHttp :: Repo -> Bool
@@ -129,15 +92,8 @@ assertLocal :: Repo -> a -> a
 assertLocal repo action = 
 	if not $ repoIsUrl repo
 		then action
-		else error $ "acting on URL git repo " ++  repoDescribe repo ++ 
+		else error $ "acting on non-local git repo " ++  repoDescribe repo ++ 
 				" not supported"
-assertUrl :: Repo -> a -> a
-assertUrl repo action = 
-	if repoIsUrl repo
-		then action
-		else error $ "acting on local git repo " ++  repoDescribe repo ++ 
-				" not supported"
-
 configBare :: Repo -> Bool
 configBare repo = maybe unknown configTrue $ M.lookup "core.bare" $ config repo
 	where
@@ -161,61 +117,10 @@ gitDir repo
  -
  - Note that for URL repositories, this is the path on the remote host. -}
 workTree :: Repo -> FilePath
-workTree r@(Repo { location = Url _ }) = urlPath r
-workTree (Repo { location = Dir d }) = d
+workTree Repo { location = Url u } = uriPath u
+workTree Repo { location = Dir d } = d
 workTree Repo { location = Unknown } = undefined
 
-{- Path of an URL repo. -}
-urlPath :: Repo -> String
-urlPath Repo { location = Url u } = uriPath u
-urlPath repo = assertUrl repo $ error "internal"
-
-{- Scheme of an URL repo. -}
-urlScheme :: Repo -> String
-urlScheme Repo { location = Url u } = uriScheme u
-urlScheme repo = assertUrl repo $ error "internal"
-
-{- Work around a bug in the real uriRegName
- - <http://trac.haskell.org/network/ticket/40> -}
-uriRegName' :: URIAuth -> String
-uriRegName' a = fixup $ uriRegName a
-	where
-		fixup x@('[':rest)
-			| rest !! len == ']' = take len rest
-			| otherwise = x
-			where
-				len  = length rest - 1
-		fixup x = x
-
-{- Hostname of an URL repo. -}
-urlHost :: Repo -> String
-urlHost = urlAuthPart uriRegName'
-
-{- Port of an URL repo, if it has a nonstandard one. -}
-urlPort :: Repo -> Maybe Integer
-urlPort r = 
-	case urlAuthPart uriPort r of
-		":" -> Nothing
-		(':':p) -> readMaybe p
-		_ -> Nothing
-
-{- Hostname of an URL repo, including any username (ie, "user@host") -}
-urlHostUser :: Repo -> String
-urlHostUser r = urlAuthPart uriUserInfo r ++ urlAuthPart uriRegName' r
-
-{- The full authority portion an URL repo. (ie, "user@host:port") -}
-urlAuthority :: Repo -> String
-urlAuthority = urlAuthPart assemble
-	where
-		assemble a = uriUserInfo a ++ uriRegName' a ++ uriPort a
-
-{- Applies a function to extract part of the uriAuthority of an URL repo. -}
-urlAuthPart :: (URIAuth -> a) -> Repo -> a
-urlAuthPart a Repo { location = Url u } = a auth
-	where
-		auth = fromMaybe (error $ "bad url " ++ show u) (uriAuthority u)
-urlAuthPart _ repo = assertUrl repo $ error "internal"
-
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
 gitCommandLine params repo@(Repo { location = Dir _ } ) =
@@ -284,39 +189,6 @@ reap = do
 	r <- catchDefaultIO (getAnyProcessStatus False True) Nothing
 	maybe (return ()) (const reap) r
 
-{- Forces git to use the specified index file.
- - Returns an action that will reset back to the default
- - index file. -}
-useIndex :: FilePath -> IO (IO ())
-useIndex index = do
-	res <- getEnv var
-	setEnv var index True
-	return $ reset res
-	where
-		var = "GIT_INDEX_FILE"
-		reset (Just v) = setEnv var v True
-		reset _ = unsetEnv var
-
-{- Runs an action that causes a git subcommand to emit a sha, and strips
-   any trailing newline, returning the sha. -}
-getSha :: String -> IO String -> IO Sha
-getSha subcommand a = do
-	t <- a
-	let t' = if last t == '\n'
-		then init t
-		else t
-	when (length t' /= shaSize) $
-		error $ "failed to read sha from git " ++ subcommand ++ " (" ++ t' ++ ")"
-	return $ Ref t'
-
-{- Size of a git sha. -}
-shaSize :: Int
-shaSize = 40
-
 {- Checks if a string from git config is a true value. -}
 configTrue :: String -> Bool
 configTrue s = map toLower s == "true"
-
-{- Access to raw config Map -}
-configMap :: Repo -> M.Map String String
-configMap = config