diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-15 16:09:30 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-15 16:09:30 -0400 |
commit | e577656fea6f66ef64547374e962adb7fd4ce80a (patch) | |
tree | 95fceeac0b0781ad8708121ee7edf58a84663686 /Commands.hs | |
parent | 80104eab9a28b9a94fb36653b7cd95b734e16e4d (diff) |
relative link fix
Diffstat (limited to 'Commands.hs')
-rw-r--r-- | Commands.hs | 25 |
1 files changed, 12 insertions, 13 deletions
diff --git a/Commands.hs b/Commands.hs index aed3a19d3..a403a5a48 100644 --- a/Commands.hs +++ b/Commands.hs @@ -6,6 +6,7 @@ import System.Console.GetOpt import Control.Monad.State (liftIO) import System.Posix.Files import System.Directory +import System.Path import Data.String.Utils import List import IO @@ -66,13 +67,14 @@ defaultCmd file = do addCmd :: FilePath -> Annex () addCmd file = inBackend file err $ do liftIO $ checkLegal file - stored <- Backend.storeFileKey file g <- Annex.gitRepo + link <- liftIO $ calcGitLink file g + stored <- Backend.storeFileKey file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just (key, backend) -> do logStatus key ValuePresent - liftIO $ setup g key + liftIO $ setup g key link where err = error $ "already annexed " ++ file checkLegal file = do @@ -80,24 +82,21 @@ addCmd file = inBackend file err $ do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - setup g key = do + calcGitLink file g = do + cwd <- getCurrentDirectory + let absfile = case (absNormPath cwd file) of + Just f -> f + Nothing -> error $ "unable to normalize " ++ file + return $ relPathDirToDir (parentDir absfile) (Git.workTree g) + setup g key link = do let dest = annexLocation g key let reldest = annexLocationRelative g key createDirectoryIfMissing True (parentDir dest) renameFile file dest - createSymbolicLink ((linkTarget file) ++ reldest) file + createSymbolicLink (link ++ reldest) file Git.run g ["add", file] Git.run g ["commit", "-m", ("git-annex annexed " ++ file), file] - linkTarget file = - -- relies on file being relative to the top of the - -- git repo; just replace each subdirectory with ".." - if (subdirs > 0) - then (join "/" $ take subdirs $ repeat "..") ++ "/" - else "" - where - subdirs = (length $ split "/" file) - 1 - {- Inverse of addCmd. -} unannexCmd :: FilePath -> Annex () |