diff options
author | 2010-10-12 00:53:42 -0400 | |
---|---|---|
committer | 2010-10-12 00:53:42 -0400 | |
commit | 92bf408c664e4fa66132a7095e1f856312ce667c (patch) | |
tree | d5b98170eac039b4b2c75e1366f1e74ee6c29412 /GitRepo.hs | |
parent | 107074d6623a687d046615a5034af10be7ff1756 (diff) |
faddle
Diffstat (limited to 'GitRepo.hs')
-rw-r--r-- | GitRepo.hs | 101 |
1 files changed, 70 insertions, 31 deletions
diff --git a/GitRepo.hs b/GitRepo.hs index 2a97e6070..dc1c52b47 100644 --- a/GitRepo.hs +++ b/GitRepo.hs @@ -7,9 +7,10 @@ module GitRepo ( GitRepo, - gitRepoFromPath, gitRepoCurrent, - gitRepoTop, + gitRepoFromPath, + gitRepoFromUrl, + gitWorkTree, gitDir, gitRelative, gitConfig, @@ -26,21 +27,28 @@ import System.IO import System.Posix.Process import Data.String.Utils import Data.Map as Map (fromList, empty, lookup, Map) +import Network.URI +import Maybe import Utility --- a git repository -data GitRepo = GitRepo { - top :: FilePath, - bare :: Bool, - config :: Map String String -} deriving (Show, Read, Eq) - -{- GitRepo constructor -} +{- A git repository can be local or remote. -} +data GitRepo = + LocalGitRepo { + top :: FilePath, + bare :: Bool, + config :: Map String String + } | RemoteGitRepo { + url :: String, + top :: FilePath, + config :: Map String String + } deriving (Show, Read, Eq) + +{- Local GitRepo constructor. -} gitRepoFromPath :: FilePath -> IO GitRepo gitRepoFromPath dir = do b <- isBareRepo dir - let r = GitRepo { + let r = LocalGitRepo { top = dir, bare = b, config = Map.empty @@ -49,28 +57,49 @@ gitRepoFromPath dir = do return r' -{- Field accessor. -} -gitRepoTop :: GitRepo -> FilePath -gitRepoTop repo = top repo +{- Remote GitRepo constructor. Note that remote repo config is not read. + - Throws exception on invalid url. -} +gitRepoFromUrl :: String -> IO GitRepo +gitRepoFromUrl url = do + return RemoteGitRepo { + url = url, + top = path url, + config = Map.empty + } + where path url = uriPath $ fromJust $ parseURI url + +{- Some code needs to vary between remote and local repos. -} +local repo = case (repo) of + LocalGitRepo {} -> True + RemoteGitRepo {} -> False +remote repo = not $ local repo +assertlocal repo action = + if (local repo) + then action + else error "acting on remote git repo not supported" {- Path to a repository's gitattributes file. -} -gitAttributes :: GitRepo -> IO String -gitAttributes repo = do +gitAttributes :: GitRepo -> String +gitAttributes repo = assertlocal repo $ do if (bare repo) - then return $ (top repo) ++ "/info/.gitattributes" - else return $ (top repo) ++ "/.gitattributes" + then (top repo) ++ "/info/.gitattributes" + else (top repo) ++ "/.gitattributes" {- Path to a repository's .git directory. - (For a bare repository, that is the root of the repository.) - TODO: support GIT_DIR -} gitDir :: GitRepo -> String -gitDir repo = +gitDir repo = assertlocal repo $ if (bare repo) then top repo else top repo ++ "/.git" -{- Given a relative or absolute filename, calculates the name to use - - to refer to the file relative to a git repository directory. +{- Path to a repository's --work-tree. -} +gitWorkTree :: GitRepo -> FilePath +gitWorkTree 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 @@ -92,26 +121,36 @@ gitAdd repo file = runGit repo ["add", file] gitCommandLine :: GitRepo -> [String] -> [String] gitCommandLine repo params = -- force use of specified repo via --git-dir and --work-tree - ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + if (local repo) + then ["--git-dir="++(gitDir repo), "--work-tree="++(top repo)] ++ params + else error "gitCommandLine not implemented for remote repo" {- Runs git in the specified repo. -} runGit :: GitRepo -> [String] -> IO () -runGit repo params = do - r <- executeFile "git" True (gitCommandLine repo params) Nothing - return () +runGit repo params = + if (local repo) + then do + r <- executeFile "git" True (gitCommandLine repo params) Nothing + return () + else error "runGit not implemented for remote repo" {- Runs a git subcommand and returns its output. -} gitPipeRead :: GitRepo -> [String] -> IO String gitPipeRead repo params = - pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do - ret <- hGetContentsStrict h - return ret + if (local repo) + then pOpen ReadFromPipe "git" (gitCommandLine repo params) $ \h -> do + ret <- hGetContentsStrict h + return ret + else error "gitPipeRead not implemented for remote repo" {- Runs git config and populates a repo with its settings. -} gitConfigRead :: GitRepo -> IO GitRepo -gitConfigRead repo = do - c <- gitPipeRead repo ["config", "--list"] - return repo { config = gitConfigParse c } +gitConfigRead repo = + if (local repo) + then do + c <- gitPipeRead repo ["config", "--list"] + return repo { config = gitConfigParse c } + else error "gitConfigRead not implemented for remote repo" {- Parses git config --list output into a config map. -} gitConfigParse :: String -> Map.Map String String |