adjust: Add --fix adjustment, which is useful when the git directory is in a nonstandard place.

7 files changed, 99 insertions, 25 deletions

diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
index bebb5c77c..a61df7d62 100644
--- a/Annex/AdjustedBranch.hs
+++ b/Annex/AdjustedBranch.hs
@@ -57,6 +57,8 @@ import qualified Data.Map as M
 data Adjustment
 	= UnlockAdjustment
 	| LockAdjustment
+	| FixAdjustment
+	| UnFixAdjustment
 	| HideMissingAdjustment
 	| ShowMissingAdjustment
 	deriving (Show, Eq)
@@ -66,32 +68,16 @@ reverseAdjustment UnlockAdjustment = LockAdjustment
 reverseAdjustment LockAdjustment = UnlockAdjustment
 reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment
 reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment
+reverseAdjustment FixAdjustment = UnFixAdjustment
+reverseAdjustment UnFixAdjustment = FixAdjustment
 
 {- How to perform various adjustments to a TreeItem. -}
 adjustTreeItem :: Adjustment -> TreeItem -> Annex (Maybe TreeItem)
-adjustTreeItem UnlockAdjustment ti@(TreeItem f m s)
-	| toBlobType m == Just SymlinkBlob = do
-		mk <- catKey s
-		case mk of
-			Just k -> do
-				Database.Keys.addAssociatedFile k f
-				Just . TreeItem f (fromBlobType FileBlob)
-					<$> hashPointerFile k
-			Nothing -> return (Just ti)
-	| otherwise = return (Just ti)
-adjustTreeItem LockAdjustment ti@(TreeItem f m s)
-	| toBlobType m /= Just SymlinkBlob = do
-		mk <- catKey s
-		case mk of
-			Just k -> do
-				absf <- inRepo $ \r -> absPath $
-					fromTopFilePath f r
-				linktarget <- calcRepo $ gitAnnexLink absf k
-				Just . TreeItem f (fromBlobType SymlinkBlob)
-					<$> hashSymlink linktarget
-			Nothing -> return (Just ti)
-	| otherwise = return (Just ti)
-adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
+adjustTreeItem UnlockAdjustment = ifSymlink adjustToPointer noAdjust
+adjustTreeItem LockAdjustment = ifSymlink noAdjust adjustToSymlink
+adjustTreeItem FixAdjustment = ifSymlink adjustToSymlink noAdjust
+adjustTreeItem UnFixAdjustment = ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust
+adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) -> do
 	mk <- catKey s
 	case mk of
 		Just k -> ifM (inAnnex k)
@@ -99,7 +85,40 @@ adjustTreeItem HideMissingAdjustment ti@(TreeItem _ _ s) = do
 			, return Nothing
 			)
 		Nothing -> return (Just ti)
-adjustTreeItem ShowMissingAdjustment ti = return (Just ti)
+adjustTreeItem ShowMissingAdjustment = noAdjust
+
+ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a
+ifSymlink issymlink notsymlink ti@(TreeItem _f m _s)
+	| toBlobType m == Just SymlinkBlob = issymlink ti
+	| otherwise = notsymlink ti
+
+noAdjust :: TreeItem -> Annex (Maybe TreeItem)
+noAdjust = return . Just
+
+adjustToPointer :: TreeItem -> Annex (Maybe TreeItem)
+adjustToPointer ti@(TreeItem f _m s) = do
+	mk <- catKey s
+	case mk of
+		Just k -> do
+			Database.Keys.addAssociatedFile k f
+			Just . TreeItem f (fromBlobType FileBlob)
+				<$> hashPointerFile k
+		Nothing -> return (Just ti)
+
+adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)
+adjustToSymlink = adjustToSymlink' gitAnnexLink
+
+adjustToSymlink' :: (FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath) -> TreeItem -> Annex (Maybe TreeItem)
+adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = do
+	mk <- catKey s
+	case mk of
+		Just k -> do
+			absf <- inRepo $ \r -> absPath $
+				fromTopFilePath f r
+			linktarget <- calcRepo $ gitannexlink absf k
+			Just . TreeItem f (fromBlobType SymlinkBlob)
+				<$> hashSymlink linktarget
+		Nothing -> return (Just ti)
 
 type OrigBranch = Branch
 newtype AdjBranch = AdjBranch { adjBranch :: Branch }
@@ -123,11 +142,15 @@ serialize UnlockAdjustment = "unlocked"
 serialize LockAdjustment = "locked"
 serialize HideMissingAdjustment = "present"
 serialize ShowMissingAdjustment = "showmissing"
+serialize FixAdjustment = "fixed"
+serialize UnFixAdjustment = "unfixed"
 
 deserialize :: String -> Maybe Adjustment
 deserialize "unlocked" = Just UnlockAdjustment
 deserialize "locked" = Just UnlockAdjustment
 deserialize "present" = Just HideMissingAdjustment
+deserialize "fixed" = Just FixAdjustment
+deserialize "unfixed" = Just UnFixAdjustment
 deserialize _ = Nothing
 
 originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
diff --git a/Annex/Locations.hs b/Annex/Locations.hs
index bdd603d94..a19560682 100644
--- a/Annex/Locations.hs
+++ b/Annex/Locations.hs
@@ -15,6 +15,7 @@ module Annex.Locations (
 	gitAnnexLocation,
 	gitAnnexLocationDepth,
 	gitAnnexLink,
+	gitAnnexLinkCanonical,
 	gitAnnexContentLock,
 	gitAnnexMapping,
 	gitAnnexInodeCache,
@@ -80,6 +81,7 @@ import Types.UUID
 import Types.GitConfig
 import Types.Difference
 import qualified Git
+import qualified Git.Types as Git
 import Git.FilePath
 import Annex.DirHashes
 import Annex.Fixup
@@ -182,6 +184,20 @@ gitAnnexLink file key r config = do
 		| otherwise = Git.localGitDir r
 	whoops = error $ "unable to normalize " ++ file
 
+{- Calculates a symlink target as would be used in a typical git
+ - repository, with .git in the top of the work tree. -}
+gitAnnexLinkCanonical :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
+gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
+  where
+	r' = case r of
+		Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } ->
+			r { Git.location = l { Git.gitdir = wt </> ".git" } }
+		_ -> r
+	config' = config
+		{ annexCrippledFileSystem = False
+		, coreSymlinks = True
+		}
+
 {- File used to lock a key's content. -}
 gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO FilePath
 gitAnnexContentLock key r config = do
diff --git a/Command/Adjust.hs b/Command/Adjust.hs
index 8c62c144c..204fd057a 100644
--- a/Command/Adjust.hs
+++ b/Command/Adjust.hs
@@ -21,6 +21,10 @@ optParser _ =
 		( long "unlock"
 		<> help "unlock annexed files"
 		)
+	<|> flag' FixAdjustment
+		( long "fix"
+		<> help "fix symlinks to annnexed files"
+		)
 	{- Not ready yet
 	<|> flag' HideMissingAdjustment
 		( long "hide-missing"
diff --git a/debian/changelog b/debian/changelog
index 1002dd0f2..24c110521 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -13,6 +13,8 @@ git-annex (6.20160512) UNRELEASED; urgency=medium
   * add: Adding a v6 pointer file used to annex it; now the pointer file is
     added to git as-is. (git add of a pointer file already did the right
     thing)
+  * adjust: Add --fix adjustment, which is useful when the git directory
+    is in a nonstandard place.
 
  -- Joey Hess <id@joeyh.name>  Wed, 11 May 2016 16:08:38 -0400
 
diff --git a/doc/bugs/git-annex_confuses_Git_with_nested_submodules/comment_6_11528378e8c509940190cf84db7ed3d6._comment b/doc/bugs/git-annex_confuses_Git_with_nested_submodules/comment_6_11528378e8c509940190cf84db7ed3d6._comment
new file mode 100644
index 000000000..a6362816a
--- /dev/null
+++ b/doc/bugs/git-annex_confuses_Git_with_nested_submodules/comment_6_11528378e8c509940190cf84db7ed3d6._comment
@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2016-05-16T20:14:57Z"
+ content="""
+I hope this will be fixed on the git side, but I don't know when it will
+be. Probably comes down to someone developing a patch.
+
+Occurs to me that git-annex could use adjusted branches to deal with this.
+When initializing in a submodule, it could enter an adjusted branch with
+`git annex adjust --fix`. This way, symlinks would be re-written to point
+to the submodule's git repository. The .git dotfile would not need to be
+converted to a symlink at all.
+"""]]
diff --git a/doc/design/adjusted_branches/comment_4_adfcbfa7a9193318cba459766a60c072._comment b/doc/design/adjusted_branches/comment_4_adfcbfa7a9193318cba459766a60c072._comment
new file mode 100644
index 000000000..2037a5f32
--- /dev/null
+++ b/doc/design/adjusted_branches/comment_4_adfcbfa7a9193318cba459766a60c072._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-05-16T20:34:28Z"
+ content="""
+@thowz great idea! And not hard at all to implement! I've done so:
+`git annex adjust --fix`
+"""]]
diff --git a/doc/git-annex-adjust.mdwn b/doc/git-annex-adjust.mdwn
index 551eabe01..a2e65661a 100644
--- a/doc/git-annex-adjust.mdwn
+++ b/doc/git-annex-adjust.mdwn
@@ -4,7 +4,7 @@ git-annex adjust - enter an adjusted branch
 
 # SYNOPSIS
 
-git annex adjust --unlock`
+git annex adjust --unlock|--fix`
 
 # DESCRIPTION
 
@@ -33,6 +33,13 @@ This command can only be used in a v6 git-annex repository.
   Unlock all annexed files in the adjusted branch. This allows
   annexed files to be modified.
 
+* `--fix`
+
+  Fix the symlinks to annexed files to point to the local git annex
+  object directory. This can be useful if a repository is checked out in an
+  unusual way that prevents the symlinks committed to git from pointing at
+  the annex objects.
+
 # SEE ALSO
 
 [[git-annex]](1)