From 9af9872f0f54d5d4af2aed3d08eef9ab67012261 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 6 Jan 2015 19:02:48 -0400
Subject: Merge from git-annex.

---
 Git.hs | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

(limited to 'Git.hs')

diff --git a/Git.hs b/Git.hs
index 55b44a9..c9750a3 100644
--- a/Git.hs
+++ b/Git.hs
@@ -30,6 +30,8 @@ module Git (
 	attributes,
 	hookPath,
 	assertLocal,
+	adjustPath,
+	relPath,
 ) where
 
 import Network.URI (uriPath, uriScheme, unEscapeString)
@@ -139,3 +141,29 @@ hookPath script repo = do
 #else
 	isexecutable f = isExecutable . fileMode <$> getFileStatus f
 #endif
+
+{- Makes the path to a local Repo be relative to the cwd. -}
+relPath :: Repo -> IO Repo
+relPath = adjustPath torel
+  where
+	torel p = do
+		p' <- relPathCwdToFile p
+		if null p'
+			then return "."
+			else return p'
+
+{- Adusts the path to a local Repo using the provided function. -}
+adjustPath :: (FilePath -> IO FilePath) -> Repo -> IO Repo
+adjustPath f r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = do
+	d' <- f d
+	w' <- maybe (pure Nothing) (Just <$$> f) w
+	return $ r 
+		{ location = l 
+			{ gitdir = d'
+			, worktree = w'
+			}
+		}
+adjustPath f r@(Repo { location = LocalUnknown d }) = do
+	d' <- f d
+	return $ r { location = LocalUnknown d' }
+adjustPath _ r = pure r
-- 
cgit v1.2.3