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