From b25abdb3e6515cf5641d2aec98539eec5439522b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 26 Nov 2013 18:11:37 -0400
Subject: [PATCH] fix reversion in relative paths to local remotes of direct
 mode repos

0980f3dae62b8a9e2d6a6b40767299559e4675a8 broke support for local remotes
from direct mode repos, because the relative path was taken to be from the
gitdir, rather than from the work tree.
---
 Annex.hs              | 30 ++++++++----------------------
 Annex/Direct/Fixup.hs | 31 +++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+), 22 deletions(-)
 create mode 100644 Annex/Direct/Fixup.hs

diff --git a/Annex.hs b/Annex.hs
index 842d930c57..583cb0e023 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -40,12 +40,11 @@ import Control.Concurrent
 import Common
 import qualified Git
 import qualified Git.Config
-import Git.Types hiding (remotes)
+import Annex.Direct.Fixup
 import Git.CatFile
 import Git.CheckAttr
 import Git.CheckIgnore
 import Git.SharedRepository
-import Git.Config
 import qualified Git.Queue
 import Types.Backend
 import Types.GitConfig
@@ -112,9 +111,9 @@ data AnnexState = AnnexState
 	, useragent :: Maybe String
 	}
 
-newState :: Git.Repo -> AnnexState
-newState r = AnnexState
-	{ repo = if annexDirect c then fixupDirect r else r
+newState :: GitConfig -> Git.Repo -> AnnexState
+newState c r = AnnexState
+	{ repo = r
 	, gitconfig = c
 	, backends = []
 	, remotes = []
@@ -145,13 +144,14 @@ newState r = AnnexState
 	, inodeschanged = Nothing
 	, useragent = Nothing
 	}
-  where
-  	c = extractGitConfig r
 
 {- Makes an Annex state object for the specified git repo.
  - Ensures the config is read, if it was not already. -}
 new :: Git.Repo -> IO AnnexState
-new = newState <$$> Git.Config.read
+new r = do
+	r' <- Git.Config.read r
+	let c = extractGitConfig r'
+	newState c <$> if annexDirect c then fixupDirect r' else return r'
 
 {- Performs an action in the Annex monad from a starting state,
  - returning a new state. -}
@@ -250,17 +250,3 @@ withCurrentState :: Annex a -> Annex (IO a)
 withCurrentState a = do
 	s <- getState id
 	return $ eval s a
-
-{- Direct mode repos have core.bare=true, but are not really bare.
- - Fix up the Repo to be a non-bare repo, and arrange for git commands
- - run by git-annex to be passed parameters that override this setting. -}
-fixupDirect :: Git.Repo -> Git.Repo
-fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) =
-	r
-		{ location = l { worktree = Just (parentDir d) }
-		, gitGlobalOpts = gitGlobalOpts r ++
-			[ Param "-c"
-			, Param $ coreBare ++ "=" ++ boolConfig False
-			]
-		}
-fixupDirect r = r
diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs
new file mode 100644
index 0000000000..13485242ae
--- /dev/null
+++ b/Annex/Direct/Fixup.hs
@@ -0,0 +1,31 @@
+{- git-annex direct mode guard fixup
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Direct.Fixup where
+
+import Git.Types
+import Git.Config
+import qualified Git.Construct as Construct
+import Utility.Path
+import Utility.SafeCommand
+
+{- Direct mode repos have core.bare=true, but are not really bare.
+ - Fix up the Repo to be a non-bare repo, and arrange for git commands
+ - run by git-annex to be passed parameters that override this setting. -}
+fixupDirect :: Repo -> IO Repo
+fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
+	let r' = r
+		{ location = l { worktree = Just (parentDir d) }
+		, gitGlobalOpts = gitGlobalOpts r ++
+			[ Param "-c"
+			, Param $ coreBare ++ "=" ++ boolConfig False
+			]
+		}
+	-- Recalc now that the worktree is correct.
+	rs' <- Construct.fromRemotes r'
+	return $ r' { remotes = rs' }
+fixupDirect r = return r