add gitRelative function
This commit is contained in:
parent
6b54817f26
commit
c920505a52
1 changed files with 19 additions and 2 deletions
21
GitRepo.hs
21
GitRepo.hs
|
@ -4,8 +4,25 @@ module GitRepo where
|
|||
|
||||
import Directory
|
||||
import System.Directory
|
||||
import System.Path
|
||||
import Data.String.Utils
|
||||
|
||||
{- Given a relative or absolute filename, calculates the name to use
|
||||
- relative to a git repository directory (which must be absolute).
|
||||
- This is the same form displayed and used by git. -}
|
||||
gitRelative :: String -> String -> String
|
||||
gitRelative file repo = drop (length absrepo) absfile
|
||||
where
|
||||
-- normalize both repo and file, so that repo
|
||||
-- will be substring of file
|
||||
absrepo = case (absNormPath "/" repo) of
|
||||
Just f -> f ++ "/"
|
||||
Nothing -> error $ "bad repo" ++ repo
|
||||
absfile = case (secureAbsNormPath absrepo file) of
|
||||
Just f -> f
|
||||
Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo
|
||||
|
||||
|
||||
{- Returns the path to the current repository's .git directory.
|
||||
- (For a bare repository, that is the root of the repository.) -}
|
||||
gitDir :: IO String
|
||||
|
@ -20,8 +37,8 @@ gitDir = do
|
|||
- directory. -}
|
||||
repoTop :: IO String
|
||||
repoTop = do
|
||||
dir <- getCurrentDirectory
|
||||
top <- seekUp dir isRepoTop
|
||||
cwd <- getCurrentDirectory
|
||||
top <- seekUp cwd isRepoTop
|
||||
case top of
|
||||
(Just dir) -> return dir
|
||||
Nothing -> error "Not in a git repository."
|
||||
|
|
Loading…
Reference in a new issue