diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-06 19:02:48 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-06 19:02:48 -0400 |
commit | 9af9872f0f54d5d4af2aed3d08eef9ab67012261 (patch) | |
tree | 4849db9d9bfa08603a4d0913bb1fbbf14213b4a4 /Git.hs | |
parent | 46b630831bda126b6f4ab723229e32c1677ae6d0 (diff) | |
download | git-repair-9af9872f0f54d5d4af2aed3d08eef9ab67012261.tar.gz |
Merge from git-annex.
Diffstat (limited to 'Git.hs')
-rw-r--r-- | Git.hs | 28 |
1 files changed, 28 insertions, 0 deletions
@@ -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 |