webapp: When adding a new local repository, fix bug that caused its group and preferred content to be set in the current repository, even when not combining.

There was a tricky bit here, when it does combine, the edit form is shown,
and so the info needs to be committed to the new repository, but then
pulled into the current one. And caches need to be invalidated for it
to be visible in the edit form.

Annex/Branch.hs

@@ -218,7 +218,7 @@ set = setJournalFile
 commit :: String -> Annex ()
 commit = whenM journalDirty . forceCommit
 
-{- Commits the current index to the branch even without any journalleda
+{- Commits the current index to the branch even without any journalled
  - changes. -}
 forceCommit :: String -> Annex ()
 forceCommit message = lockJournal $ \jl -> do

Assistant/WebApp/Configurators/Edit.hs

@@ -61,6 +61,10 @@ data RepoConfig = RepoConfig
 
 getRepoConfig :: UUID -> Maybe Remote -> Annex RepoConfig
 getRepoConfig uuid mremote = do
+	-- Ensure we're editing current data by discarding caches.
+	void groupMapLoad
+	void uuidMapLoad
+
 	groups <- lookupGroups uuid
 	remoteconfig <- M.lookup uuid <$> readRemoteLog
 	let (repogroup, associateddirectory) = case getStandardGroup groups of

Assistant/WebApp/Configurators/Local.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant webapp configurators for making local repositories
  -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -19,6 +19,7 @@ import qualified Git
 import qualified Git.Construct
 import qualified Git.Config
 import qualified Git.Command
+import qualified Git.Branch
 import qualified Annex
 import Config.Files
 import Utility.FreeDesktop
@@ -196,8 +197,7 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 		FormSuccess (RepositoryPath p) -> do
 			let path = T.unpack p
 			isnew <- liftIO $ makeRepo path False
-			u <- liftIO $ initRepo isnew True path Nothing
-			liftH $ liftAnnexOr () $ setStandardGroup u ClientGroup
+			u <- liftIO $ initRepo isnew True path Nothing (Just ClientGroup)
 			liftIO $ addAutoStartFile path
 			liftIO $ startAssistant path
 			askcombine u path
@@ -211,7 +211,13 @@ postNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 getCombineRepositoryR :: FilePath -> UUID -> Handler Html
 getCombineRepositoryR newrepopath newrepouuid = do
 	r <- combineRepos newrepopath remotename
-	liftAssistant $ syncRemote r
+	liftAssistant $ do
+		-- Manually pull from the remote, to ensure its description
+		-- and group etc are available before editing.
+		currentbranch <- liftAnnex (inRepo Git.Branch.current)
+		void $ manualPull currentbranch [r]
+		-- Sync with the remote to push to it as well.
+		syncRemote r
 	redirect $ EditRepositoryR $ RepoUUID newrepouuid
   where
 	remotename = takeFileName newrepopath
@@ -321,7 +327,7 @@ getFinishAddDriveR drive = go
 			return (u, r)
 	{- Making a new unencrypted repo, or combining with an existing one. -}
 	makeunencrypted = makewith $ \isnew -> (,)
-		<$> liftIO (initRepo isnew False dir $ Just remotename)
+		<$> liftIO (initRepo isnew False dir (Just remotename) Nothing)
 		<*> combineRepos dir remotename
 	makewith a = do
 		liftIO $ createDirectoryIfMissing True dir
@@ -398,10 +404,8 @@ startFullAssistant path repogroup setup = do
 	webapp <- getYesod
 	url <- liftIO $ do
 		isnew <- makeRepo path False
-		u <- initRepo isnew True path Nothing
-		inDir path $ do
-			setStandardGroup u repogroup
-			fromMaybe noop setup
+		void $ initRepo isnew True path Nothing (Just repogroup)
+		inDir path $ fromMaybe noop setup
 		addAutoStartFile path
 		setCurrentDirectory path
 		fromJust $ postFirstRun webapp
@@ -432,9 +436,9 @@ inDir dir a = do
 	Annex.eval state a
 
 {- Creates a new repository, and returns its UUID. -}
-initRepo :: Bool -> Bool -> FilePath -> Maybe String -> IO UUID
-initRepo True primary_assistant_repo dir desc = inDir dir $ do
-	initRepo' desc
+initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID
+initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
+	initRepo' desc mgroup
 	{- Initialize the master branch, so things that expect
 	 - to have it will work, before any files are added. -}
 	unlessM (Git.Config.isBare <$> gitRepo) $
@@ -456,16 +460,18 @@ initRepo True primary_assistant_repo dir desc = inDir dir $ do
 			[Param "config", Param "gc.auto", Param "0"]
 	getUUID
 {- Repo already exists, could be a non-git-annex repo though. -}
-initRepo False _ dir desc = inDir dir $ do
-	initRepo' desc
+initRepo False _ dir desc mgroup = inDir dir $ do
+	initRepo' desc mgroup
 	getUUID
 
-initRepo' :: Maybe String -> Annex ()
-initRepo' desc = unlessM isInitialized $ do
-	initialize desc
+initRepo' :: Maybe String -> Maybe StandardGroup -> Annex ()
+initRepo' desc mgroup = do
+	unlessM isInitialized $ do
+		initialize desc
+	u <- getUUID
+	maybe noop (setStandardGroup u) mgroup
 	{- Ensure branch gets committed right away so it is
-	 - available for merging when a removable drive repo is being
-	 - added. -}
+	 - available for merging immediately. -}
 	Annex.Branch.commit "update"
 
 {- Checks if the user can write to a directory.

Assistant/WebApp/Types.hs

@@ -83,27 +83,15 @@ instance Yesod WebApp where
 instance RenderMessage WebApp FormMessage where
 	renderMessage _ _ = defaultFormMessage
 
-{- Runs an Annex action from the webapp.
- -
- - When the webapp is run outside a git-annex repository, the fallback
- - value is returned.
- -}
-#if MIN_VERSION_yesod(1,2,0)
-liftAnnexOr :: forall a. a -> Annex a -> Handler a
-#else
-liftAnnexOr :: forall sub a. a -> Annex a -> GHandler sub WebApp a
-#endif
-liftAnnexOr fallback a = ifM (noAnnex <$> getYesod)
-	( return fallback
-	, liftAssistant $ liftAnnex a
-	)
-
 #if MIN_VERSION_yesod(1,2,0)
 instance LiftAnnex Handler where
 #else
 instance LiftAnnex (GHandler sub WebApp) where
 #endif
-	liftAnnex = liftAnnexOr $ error "internal liftAnnex"
+	liftAnnex a = ifM (noAnnex <$> getYesod)
+		( error "internal liftAnnex"
+		, liftAssistant $ liftAnnex a
+		)
 
 #if MIN_VERSION_yesod(1,2,0)
 instance LiftAnnex (WidgetT WebApp IO) where

debian/changelog

@@ -1,3 +1,11 @@
+git-annex (5.20140530) UNRELEASED; urgency=medium
+
+  * webapp: When adding a new local repository, fix bug that caused its
+    group and preferred content to be set in the current repository,
+    even when not combining.
+
+ -- Joey Hess <joeyh@debian.org>  Thu, 29 May 2014 20:10:59 -0400
+
 git-annex (5.20140529) unstable; urgency=medium
 
   * Fix encoding of data written to git-annex branch. Avoid truncating

doc/bugs/Assistant_doesn__39__t_keep_separate_local_repositories_100__37___separate.mdwn

@@ -431,3 +431,5 @@ wanted f3b332fd-4b7a-4a5b-b077-8f13d3d9a407 = standard
 # (for trh@r9-y3pll:~/bar)
 #schedule 357eaef4-af1b-491a-a003-01c2d583056e =
 </code></pre>
+
+> [[fixed|done]] --[[Joey]]