mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix relative

Browse source 
Not currently used, but was buggy.
This commit is contained in:
Joey Hess 2011-04-25 13:02:54 -04:00
parent 8512a4a1a1
commit b0b413c69f
1 changed files with 7 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
GitRepo.hs
View file

@ -59,7 +59,7 @@ module GitRepo (
prop_idempotent_deencode prop_idempotent_deencode
) where ) where
import Control.Monad (unless) import Control.Monad (unless, when)
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.Posix.Directory import System.Posix.Directory
@ -242,7 +242,11 @@ workTree Repo { location = Unknown } = undefined
relative :: Repo -> FilePath -> IO FilePath relative :: Repo -> FilePath -> IO FilePath
relative repo@(Repo { location = Dir d }) file = do relative repo@(Repo { location = Dir d }) file = do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
return $ drop (length absrepo) (absfile cwd) let file' = absfile cwd
let len = length absrepo
when (take len file' /= absrepo) $
error $ file ++ " is not located inside git repository " ++ absrepo
return $ drop (length absrepo) file'
where where
-- normalize both repo and file, so that repo -- normalize both repo and file, so that repo
-- will be substring of file -- will be substring of file
@ -251,7 +255,7 @@ relative repo@(Repo { location = Dir d }) file = do
Nothing -> error $ "bad repo" ++ repoDescribe repo Nothing -> error $ "bad repo" ++ repoDescribe repo
absfile c = case (secureAbsNormPath c file) of absfile c = case (secureAbsNormPath c file) of
Just f -> f Just f -> f
Nothing -> error $ file ++ " is not located inside git repository " ++ absrepo Nothing -> file
relative repo _ = assertLocal repo $ error "internal" relative repo _ = assertLocal repo $ error "internal"
{- Path of an URL repo. -} {- Path of an URL repo. -}