add fix subcommand

3 files changed, 40 insertions, 12 deletions

diff --git a/Commands.hs b/Commands.hs
index b9f31a56c..8afe66b91 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -40,6 +40,7 @@ cmds =  [
 	, (Command "pull"	pullCmd		RepoName)
 	, (Command "unannex"	unannexCmd	FilesInGit)
 	, (Command "describe"	describeCmd	SingleString)
+	, (Command "fix"	fixCmd		FilesInGit)
 	]
 
 options = [
@@ -89,13 +90,12 @@ addCmd :: FilePath -> Annex ()
 addCmd file = inBackend file err $ do
 	liftIO $ checkLegal 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
-			setup g key link
+			setup g key
 	where
 		err = error $ "already annexed " ++ file
 		checkLegal file = do
@@ -103,21 +103,15 @@ addCmd file = inBackend file err $ do
 			if ((isSymbolicLink s) || (not $ isRegularFile s))
 				then error $ "not a regular file: " ++ file
 				else return ()
-		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
+		setup g key = do
 			let dest = annexLocation g key
-			let reldest = annexLocationRelative g key
 			liftIO $ createDirectoryIfMissing True (parentDir dest)
 			liftIO $ renameFile file dest
-			liftIO $ createSymbolicLink (link ++ reldest) file
+			link <- calcGitLink file key
+			liftIO $ createSymbolicLink link file
 			gitAdd file $ Just $ "git-annex annexed " ++ file
 
-{- Inverse of addCmd. -}
+{- Undo addCmd. -}
 unannexCmd :: FilePath -> Annex ()
 unannexCmd file = notinBackend file err $ \(key, backend) -> do
 	Backend.removeKey backend key
@@ -181,6 +175,25 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do
 	where
 		err = error $ "not annexed " ++ file
 
+{- Fixes the symlink to an annexed file. -}
+fixCmd :: String -> Annex ()
+fixCmd file = notinBackend file err $ \(key, backend) -> do
+	link <- calcGitLink file key
+	checkLegal file
+	liftIO $ createDirectoryIfMissing True (parentDir file)
+	liftIO $ removeFile file
+	liftIO $ createSymbolicLink link file
+	gitAdd file $ Just $ "git-annex fix " ++ file
+	where
+		checkLegal file = do
+			s <- liftIO $ getSymbolicLinkStatus file
+			force <- Annex.flagIsSet Force
+			if (not (isSymbolicLink s) && not force)
+				then error $ "not a symbolic link : " ++ file ++
+					"  (use --force to override this sanity check)"
+				else return ()
+		err = error $ "not annexed " ++ file
+
 {- Pushes all files to a remote repository. -}
 pushCmd :: String -> Annex ()
 pushCmd reponame = do error "not implemented" -- TODO
diff --git a/Core.hs b/Core.hs
index 5f5cba295..021595f8b 100644
--- a/Core.hs
+++ b/Core.hs
@@ -6,12 +6,14 @@ import Maybe
 import System.IO
 import System.Directory
 import Control.Monad.State (liftIO)
+import System.Path
 
 import Types
 import Locations
 import UUID
 import qualified GitRepo as Git
 import qualified Annex
+import Utility
 			
 {- Sets up a git repo for git-annex. -}
 startup :: [Flag] -> Annex ()
@@ -81,3 +83,14 @@ gitAdd file commitmessage = do
 				then liftIO $ Git.run g ["commit", "-m",
 					(fromJust commitmessage), file]
 				else return ()
+
+{- Calculates the relative path to use to link a file to a key. -}
+calcGitLink :: FilePath -> Key -> Annex FilePath
+calcGitLink file key = do
+	g <- Annex.gitRepo
+	cwd <- liftIO $ getCurrentDirectory
+	let absfile = case (absNormPath cwd file) of
+		Just f -> f
+		Nothing -> error $ "unable to normalize " ++ file
+	return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++
+		annexLocationRelative g key
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index e552dc770..e65ad5b02 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -47,6 +47,8 @@ Enough broad picture, here's how it actually looks:
   repository.
 * `git annex pull $repository` pulls *all* annexed files from the specified
   repository.
+* `git annex file $file` adjusts the symlink for the file to point to its
+  content again. Use this if you've moved the file around.
 * `git annex unannex $file` undoes a `git annex add`. But use `git annex drop`
   if you're just done with a file; only use `unannex` if you
   accidentially added a file.