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 Directory
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import System.Path
|
||||||
import Data.String.Utils
|
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.
|
{- Returns the path to the current repository's .git directory.
|
||||||
- (For a bare repository, that is the root of the repository.) -}
|
- (For a bare repository, that is the root of the repository.) -}
|
||||||
gitDir :: IO String
|
gitDir :: IO String
|
||||||
|
@ -20,8 +37,8 @@ gitDir = do
|
||||||
- directory. -}
|
- directory. -}
|
||||||
repoTop :: IO String
|
repoTop :: IO String
|
||||||
repoTop = do
|
repoTop = do
|
||||||
dir <- getCurrentDirectory
|
cwd <- getCurrentDirectory
|
||||||
top <- seekUp dir isRepoTop
|
top <- seekUp cwd isRepoTop
|
||||||
case top of
|
case top of
|
||||||
(Just dir) -> return dir
|
(Just dir) -> return dir
|
||||||
Nothing -> error "Not in a git repository."
|
Nothing -> error "Not in a git repository."
|
||||||
|
|
Loading…
Reference in a new issue