Newer
Older
{- git repository handling
-
- This is written to be completely independant of git-annex and should be
- suitable for other uses.
-
- Copyright 2010, 2011 Joey Hess <joey@kitenet.net>
Ref(..),
Branch,
Sha,
Tag,
hookPath,
import Network.URI (uriPath, uriScheme, unEscapeString)
import System.Directory
{- User-visible description of a git repo. -}
repoDescribe Repo { remoteName = Just name } = name
repoDescribe Repo { location = Url url } = show url
repoDescribe Repo { location = Dir dir } = dir
repoDescribe Repo { location = Unknown } = "UNKNOWN"
{- Location of the repo, either as a path or url. -}
repoLocation :: Repo -> String
repoLocation Repo { location = Url url } = show url
repoLocation Repo { location = Dir dir } = dir
repoLocation Repo { location = Unknown } = undefined
{- Some code needs to vary between URL and normal repos,
- or bare and non-bare, these functions help with that. -}
repoIsUrl Repo { location = Url _ } = True
repoIsUrl _ = False
repoIsSsh Repo { location = Url url }
-- git treats these the same as ssh
| scheme == "git+ssh:" = True
| scheme == "ssh+git:" = True
| otherwise = False
repoIsSsh _ = False
repoIsHttp :: Repo -> Bool
repoIsHttp Repo { location = Url url }
| uriScheme url == "http:" = True
| uriScheme url == "https:" = True
| otherwise = False
repoIsHttp _ = False
configAvail ::Repo -> Bool
repoIsLocalBare r@(Repo { location = Dir _ }) = configAvail r && configBare r
else error $ "acting on non-local git repo " ++ repoDescribe repo ++
configBare repo = maybe unknown (fromMaybe False . configTrue) $
M.lookup "core.bare" $ config repo
where
unknown = error $ "it is not known if git repo " ++
" is a bare repository; config not read"
{- Path to a repository's gitattributes file. -}
attributes :: Repo -> FilePath
attributes repo
| configBare repo = workTree repo ++ "/info/.gitattributes"
gitDir :: Repo -> FilePath
| configBare repo = workTree repo
| otherwise = workTree repo </> ".git"
{- Path to a given hook script in a repository, only if the hook exists
- and is executable. -}
hookPath :: String -> Repo -> IO (Maybe FilePath)
hookPath script repo = do
let hook = gitDir repo </> "hooks" </> script
e <- doesFileExist hook
if e
then do
m <- fileMode <$> getFileStatus hook
return $ if isExecutable m then Just hook else Nothing
else return Nothing
{- Path to a repository's --work-tree, that is, its top.
-
- Note that for URL repositories, this is the path on the remote host. -}
workTree Repo { location = Url u } = unEscapeString $ uriPath u
workTree Repo { location = Unknown } = undefined
{- Checks if a string from git config is a true value. -}