diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 7a75d8acf6..108f97b14d 100644 --- a/Annex/Branch.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index 17dc5f1564..b6e63a66c8 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 5e8654389c..5b333ff275 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -1,6 +1,6 @@ {- git-annex assistant webapp configurators for making local repositories - - - Copyright 2012 Joey Hess + - Copyright 2012-2014 Joey Hess - - 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. diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs index 85c05448de..cc4518018c 100644 --- a/Assistant/WebApp/Types.hs +++ b/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 diff --git a/debian/changelog b/debian/changelog index fa372d828e..c1a7e3c039 100644 --- a/debian/changelog +++ b/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 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 diff --git a/doc/bugs/Assistant_doesn__39__t_keep_separate_local_repositories_100__37___separate.mdwn b/doc/bugs/Assistant_doesn__39__t_keep_separate_local_repositories_100__37___separate.mdwn index 54f8134d4b..0ad0f1eb37 100644 --- a/doc/bugs/Assistant_doesn__39__t_keep_separate_local_repositories_100__37___separate.mdwn +++ b/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 = + +> [[fixed|done]] --[[Joey]]