add gitRelative function

1 files changed, 19 insertions, 2 deletions

diff --git a/GitRepo.hs b/GitRepo.hs
index fece79785..f1372bf3a 100644
--- a/GitRepo.hs
+++ b/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."