relative link fix
This commit is contained in:
parent
80104eab9a
commit
e577656fea
3 changed files with 61 additions and 17 deletions
25
Commands.hs
25
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 ()
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue