webapp: Can now add a new local repository, and make it sync with the main local repository.

Assistant/WebApp/Configurators/Local.hs

@@ -11,6 +11,7 @@ module Assistant.WebApp.Configurators.Local where
 
 import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
+import Assistant.WebApp.OtherRepos
 import Assistant.MakeRemote
 import Init
 import qualified Git
@@ -135,20 +136,35 @@ getFirstRepositoryR = page "Getting started" (Just Configuration) $ do
 			startFullAssistant $ T.unpack p
 		_ -> $(widgetFile "configurators/newrepository/first")
 
-{- Adding a new, separate repository. -}
+{- Adding a new local repository, which may be entirely separate, or may
+ - be connected to the current repository. -}
 getNewRepositoryR :: Handler RepHtml
 getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 	home <- liftIO myHomeDir
 	((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
 	case res of
-		FormSuccess (RepositoryPath p) -> lift $ do
+		FormSuccess (RepositoryPath p) -> do
 			let path = T.unpack p
 			liftIO $ makeRepo path False
 			u <- liftIO $ initRepo True path Nothing
-			runAnnex () $ setStandardGroup u ClientGroup
+			lift $ runAnnex () $ setStandardGroup u ClientGroup
 			liftIO $ addAutoStart path
-			redirect $ SwitchToRepositoryR path
+			liftIO $ startAssistant path
+			askcombine u path
 		_ -> $(widgetFile "configurators/newrepository")
+  where
+	askcombine newrepouuid newrepopath = do
+		newrepo <- liftIO $ relHome newrepopath
+		mainrepo <- fromJust . relDir <$> lift getYesod
+		$(widgetFile "configurators/newrepository/combine")
+
+getCombineRepositoryR :: FilePath -> UUID -> Handler RepHtml
+getCombineRepositoryR newrepopath newrepouuid = do
+	r <- combineRepos newrepopath remotename
+	syncRemote r
+	redirect $ EditRepositoryR newrepouuid
+  where
+	remotename = takeFileName newrepopath
 
 data RemovableDrive = RemovableDrive 
 	{ diskFree :: Maybe Integer
@@ -188,7 +204,7 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 	make mountpoint = do
 		liftIO $ makerepo dir
 		u <- liftIO $ initRepo False dir $ Just remotename
-		r <- addremote dir remotename
+		r <- combineRepos dir remotename
 		runAnnex () $ setStandardGroup u TransferGroup
 		syncRemote r
 		return u
@@ -204,12 +220,15 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
 			_ -> do
 				createDirectoryIfMissing True dir
 				makeRepo dir True
-	{- Each repository is made a remote of the other. -}
-	addremote dir name = runAnnex undefined $ do
-		hostname <- maybe "host" id <$> liftIO getHostname
-		hostlocation <- fromRepo Git.repoLocation
-		liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
-		addRemote $ makeGitRemote name dir
+
+{- Each repository is made a remote of the other.
+ - Next call syncRemote to get them in sync. -}
+combineRepos :: FilePath -> String -> Handler Remote
+combineRepos dir name = runAnnex undefined $ do
+	hostname <- maybe "host" id <$> liftIO getHostname
+	hostlocation <- fromRepo Git.repoLocation
+	liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
+	addRemote $ makeGitRemote name dir
 
 getEnableDirectoryR :: UUID -> Handler RepHtml
 getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do

Assistant/WebApp/OtherRepos.hs

@@ -43,14 +43,9 @@ listOtherRepos = do
  -}
 getSwitchToRepositoryR :: FilePath -> Handler RepHtml
 getSwitchToRepositoryR repo = do
-	liftIO startassistant
-	url <- liftIO geturl
-	redirect url
+	liftIO $ startAssistant repo
+	redirect =<< liftIO geturl
   where
-	startassistant = do
-		program <- readProgramFile
-		void $ forkIO $ void $ createProcess $
-			(proc program ["assistant"]) { cwd = Just repo }
 	geturl = do
 		r <- Git.Config.read =<< Git.Construct.fromPath repo
 		waiturl $ gitAnnexUrlFile r
@@ -66,3 +61,9 @@ getSwitchToRepositoryR repo = do
 	delayed a = do
 		threadDelay 100000 -- 1/10th of a second
 		a
+
+startAssistant :: FilePath -> IO ()
+startAssistant repo = do
+	program <- readProgramFile
+	void $ forkIO $ void $ createProcess $
+		(proc program ["assistant"]) { cwd = Just repo }

Assistant/WebApp/routes

@@ -20,6 +20,7 @@
 /config/repository/new NewRepositoryR GET
 /config/repository/switcher RepositorySwitcherR GET
 /config/repository/switchto/#FilePath SwitchToRepositoryR GET
+/config/repository/combine/#FilePath/#UUID CombineRepositoryR GET
 /config/repository/edit/#UUID EditRepositoryR GET
 /config/repository/edit/new/#UUID EditNewRepositoryR GET
 /config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET

debian/changelog

@@ -4,6 +4,8 @@ git-annex (3.20130217) UNRELEASED; urgency=low
     always using git's pseudosymlink files in such repositories.
   * webapp: Allow creating repositories on filesystems that lack support for
     symlinks.
+  * webapp: Can now add a new local repository, and make it sync with
+    the main local repository.
   * Android: Bundle now includes openssh.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 17 Feb 2013 16:42:16 -0400

templates/configurators/newrepository.hamlet

@@ -1,15 +1,7 @@
 <div .span9 .hero-unit>
   <h2>
-    Add another repository
-  <p>
-    The form below will make a separate repository, that is not synced #
-    with your existing repository. You can use the new repository for #
-    different sorts of files, that are synced and shared with other #
-    devices and users.
+    Add another local repository
   <p>
+    Where do you want to put this new repository?
     <form .form-inline enctype=#{enctype}>
       ^{form}
-  <p>
-    <i .icon-asterisk></i> #
-    Do you want to add another repository that is kept in sync with #
-    the current one? If so, <a href="@{RepositoriesR}">go here</a>.

templates/configurators/newrepository/combine.hamlet

@@ -2,16 +2,16 @@
   <h2>
     Combine repositories?
   <p>
-    You have created a new repository at #{newrepopath}. #
-    Do you want to combine it with your existing repository at #{mainrepopath}?
+    You have created a new repository at #{newrepo}.
+    <br>
+    Do you want to combine it with your existing repository at #{mainrepo}?
   <p>
-    Combining the repositories will sync their files, so each will have #
-    added to it all files from the other repository.
+    <a .btn href="@{CombineRepositoryR newrepopath newrepouuid}">
+      <i .icon-resize-small></i> Combine the repositories #
+    The combined repositories will sync and share their files.
   <p>
-    If you want to use the new repository to hold different sorts of files, #
-    you should not combine the repositories.
+    -or-
   <p>
-    <a .btn .btn-primary href="@{CombineRepository newrepopath}">
-      <i .icon-resize-small></i> Combine the repositories
     <a .btn href="@{SwitchToRepositoryR newrepopath}">
-      <i .icon-resize-full></i> Keep the repositories separate
+      <i .icon-resize-full></i> Keep the repositories separate #
+    Files placed in one will not be synced to the other.

templates/configurators/repositories/misc.hamlet

@@ -15,9 +15,7 @@
 <p>
   Pair with a computer to automatically keep files in sync #
   over your local network.
-
 <p>
-
   For easy sharing with friends and devices in the same location.
 
 <h3>
@@ -31,6 +29,12 @@
 
   For easy sharing with friends and devices, over the internet.
 
+<h3>
+  <a href="@{NewRepositoryR}">
+    <i .icon-plus-sign></i> Add a local repository
+<p>
+  Make another repository on your computer.
+
 <h3>
   <i .icon-plus-sign></i> Phone
 <p>