diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-14 02:36:41 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-14 02:36:41 -0400 |
commit | 48643b68b3ff05399b72f44b8b02ff34d6de046c (patch) | |
tree | 530364b80bada325413dfa86f7b5e68ee007ee27 /GitRepo.hs | |
parent | eda80e44c5fb399fa4e5625388d6e0f993b0f779 (diff) |
convert GitRepo to qualified import
Diffstat (limited to 'GitRepo.hs')
-rw-r--r-- | GitRepo.hs | 158 |
1 files changed, 77 insertions, 81 deletions
diff --git a/GitRepo.hs b/GitRepo.hs index d22218219..f3bb5427a 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -3,27 +3,27 @@ - This is written to be completely independant of git-annex and should be - suitable for other uses. - - - -} + -} module GitRepo ( - GitRepo, - gitRepoFromCwd, - gitRepoFromPath, - gitRepoFromUrl, - gitRepoIsLocal, - gitRepoIsRemote, - gitRepoDescribe, - gitWorkTree, - gitDir, - gitRelative, - gitConfig, - gitConfigMap, - gitConfigRead, - gitRun, - gitAttributes, - gitRepoRemotes, - gitRepoRemotesAdd, - gitRepoRemoteName + Repo, + repoFromCwd, + repoFromPath, + repoFromUrl, + repoIsLocal, + repoIsRemote, + repoDescribe, + workTree, + dir, + relative, + configGet, + configMap, + configRead, + run, + attributes, + remotes, + remotesAdd, + repoRemoteName ) where import Directory @@ -44,35 +44,35 @@ import Utility {- A git repository can be on local disk or remote. Not to be confused - with a git repo's configured remotes, some of which may be on local - disk. -} -data GitRepo = - LocalGitRepo { +data Repo = + LocalRepo { top :: FilePath, config :: Map String String, - remotes :: [GitRepo], + remotes :: [Repo], -- remoteName holds the name used for this repo in remotes remoteName :: Maybe String - } | RemoteGitRepo { + } | RemoteRepo { url :: String, top :: FilePath, config :: Map String String, - remotes :: [GitRepo], + remotes :: [Repo], remoteName :: Maybe String } deriving (Show, Read, Eq) -{- Local GitRepo constructor. -} -gitRepoFromPath :: FilePath -> GitRepo -gitRepoFromPath dir = - LocalGitRepo { +{- Local Repo constructor. -} +repoFromPath :: FilePath -> Repo +repoFromPath dir = + LocalRepo { top = dir, config = Map.empty, remotes = [], remoteName = Nothing } -{- Remote GitRepo constructor. Throws exception on invalid url. -} -gitRepoFromUrl :: String -> GitRepo -gitRepoFromUrl url = - RemoteGitRepo { +{- Remote Repo constructor. Throws exception on invalid url. -} +repoFromUrl :: String -> Repo +repoFromUrl url = + RemoteRepo { url = url, top = path url, config = Map.empty, @@ -82,72 +82,68 @@ gitRepoFromUrl url = where path url = uriPath $ fromJust $ parseURI url {- User-visible description of a git repo. -} -gitRepoDescribe repo = +repoDescribe repo = if (isJust $ remoteName repo) then fromJust $ remoteName repo - else if (gitRepoIsLocal repo) + else if (repoIsLocal repo) then top repo else url repo -{- Returns the list of a repo's remotes. -} -gitRepoRemotes :: GitRepo -> [GitRepo] -gitRepoRemotes r = remotes r - {- Constructs and returns an updated version of a repo with - different remotes list. -} -gitRepoRemotesAdd :: GitRepo -> [GitRepo] -> GitRepo -gitRepoRemotesAdd repo rs = repo { remotes = rs } +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. Otherwise, "" -} -gitRepoRemoteName r = +repoRemoteName r = if (isJust $ remoteName r) then fromJust $ remoteName r else "" {- Some code needs to vary between remote and local repos, or bare and - non-bare, these functions help with that. -} -gitRepoIsLocal repo = case (repo) of - LocalGitRepo {} -> True - RemoteGitRepo {} -> False -gitRepoIsRemote repo = not $ gitRepoIsLocal repo +repoIsLocal repo = case (repo) of + LocalRepo {} -> True + RemoteRepo {} -> False +repoIsRemote repo = not $ repoIsLocal repo assertlocal repo action = - if (gitRepoIsLocal repo) + if (repoIsLocal repo) then action - else error $ "acting on remote git repo " ++ (gitRepoDescribe repo) ++ + else error $ "acting on remote git repo " ++ (repoDescribe repo) ++ " not supported" -bare :: GitRepo -> Bool +bare :: Repo -> Bool bare repo = if (member b (config repo)) then ("true" == fromJust (Map.lookup b (config repo))) - else error $ "it is not known if git repo " ++ (gitRepoDescribe repo) ++ + else error $ "it is not known if git repo " ++ (repoDescribe repo) ++ " is a bare repository; config not read" where b = "core.bare" {- Path to a repository's gitattributes file. -} -gitAttributes :: GitRepo -> String -gitAttributes repo = assertlocal repo $ do +attributes :: Repo -> String +attributes repo = assertlocal repo $ do if (bare repo) then (top repo) ++ "/info/.gitattributes" else (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory, relative to its topdir. -} -gitDir :: GitRepo -> String -gitDir repo = assertlocal repo $ +dir :: Repo -> String +dir repo = assertlocal repo $ if (bare repo) then "" else ".git" {- Path to a repository's --work-tree. -} -gitWorkTree :: GitRepo -> FilePath -gitWorkTree repo = top repo +workTree :: Repo -> FilePath +workTree repo = top repo {- Given a relative or absolute filename in a repository, calculates the - name to use to refer to the file relative to a git repository's top. - This is the same form displayed and used by git. -} -gitRelative :: GitRepo -> String -> String -gitRelative repo file = drop (length absrepo) absfile +relative :: Repo -> String -> String +relative repo file = drop (length absrepo) absfile where -- normalize both repo and file, so that repo -- will be substring of file @@ -159,27 +155,27 @@ gitRelative repo file = drop (length absrepo) absfile Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo {- Constructs a git command line operating on the specified repo. -} -gitCommandLine :: GitRepo -> [String] -> [String] +gitCommandLine :: Repo -> [String] -> [String] gitCommandLine repo params = assertlocal repo $ -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(top repo)++"/"++(gitDir repo), "--work-tree="++(top repo)] ++ params + ["--git-dir="++(top repo)++"/"++(dir repo), "--work-tree="++(top repo)] ++ params {- Runs git in the specified repo. -} -gitRun :: GitRepo -> [String] -> IO () -gitRun repo params = assertlocal repo $ do +run :: Repo -> [String] -> IO () +run repo params = assertlocal repo $ do r <- rawSystem "git" (gitCommandLine repo params) return () {- Runs a git subcommand and returns its output. -} -gitPipeRead :: GitRepo -> [String] -> IO String +gitPipeRead :: Repo -> [String] -> IO String gitPipeRead repo params = assertlocal repo $ do pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do ret <- hGetContentsStrict h return ret {- Runs git config and populates a repo with its config. -} -gitConfigRead :: GitRepo -> IO GitRepo -gitConfigRead repo = assertlocal repo $ do +configRead :: Repo -> IO Repo +configRead repo = assertlocal repo $ do {- Cannot use gitPipeRead because it relies on the config having been already read. Instead, chdir to the repo. -} cwd <- getCurrentDirectory @@ -187,12 +183,12 @@ gitConfigRead repo = assertlocal repo $ do (\_ -> changeWorkingDirectory cwd) $ pOpen ReadFromPipe "git" ["config", "--list"] $ \h -> do val <- hGetContentsStrict h - let r = repo { config = gitConfigParse val } - return r { remotes = gitConfigRemotes r } + let r = repo { config = configParse val } + return r { remotes = configRemotes r } {- Calculates a list of a repo's configured remotes, by parsing its config. -} -gitConfigRemotes :: GitRepo -> [GitRepo] -gitConfigRemotes repo = map construct remotes +configRemotes :: Repo -> [Repo] +configRemotes repo = map construct remotes where remotes = toList $ filter $ config repo filter = filterWithKey (\k _ -> isremote k) @@ -200,12 +196,12 @@ gitConfigRemotes repo = map construct remotes remotename k = (split "." k) !! 1 construct (k,v) = (gen v) { remoteName = Just $ remotename k } gen v = if (isURI v) - then gitRepoFromUrl v - else gitRepoFromPath v + then repoFromUrl v + else repoFromPath v {- Parses git config --list output into a config map. -} -gitConfigParse :: String -> Map.Map String String -gitConfigParse s = Map.fromList $ map pair $ lines s +configParse :: String -> Map.Map String String +configParse s = Map.fromList $ map pair $ lines s where pair l = (key l, val l) key l = (keyval l) !! 0 @@ -214,21 +210,21 @@ gitConfigParse s = Map.fromList $ map pair $ lines s sep = "=" {- Returns a single git config setting, or a default value if not set. -} -gitConfig :: GitRepo -> String -> String -> String -gitConfig repo key defaultValue = +configGet :: Repo -> String -> String -> String +configGet repo key defaultValue = Map.findWithDefault defaultValue key (config repo) {- Access to raw config Map -} -gitConfigMap :: GitRepo -> Map String String -gitConfigMap repo = config repo +configMap :: Repo -> Map String String +configMap repo = config repo {- Finds the current git repository, which may be in a parent directory. -} -gitRepoFromCwd :: IO GitRepo -gitRepoFromCwd = do +repoFromCwd :: IO Repo +repoFromCwd = do cwd <- getCurrentDirectory top <- seekUp cwd isRepoTop case top of - (Just dir) -> return $ gitRepoFromPath dir + (Just dir) -> return $ repoFromPath dir Nothing -> error "Not in a git repository." seekUp :: String -> (String -> IO Bool) -> IO (Maybe String) @@ -241,11 +237,11 @@ seekUp dir want = do d -> seekUp d want isRepoTop dir = do - r <- isGitRepo dir + r <- isRepo dir b <- isBareRepo dir return (r || b) where - isGitRepo dir = gitSignature dir ".git" ".git/config" + isRepo dir = gitSignature dir ".git" ".git/config" isBareRepo dir = gitSignature dir "objects" "config" gitSignature dir subdir file = do s <- (doesDirectoryExist (dir ++ "/" ++ subdir)) |