move local repo list out of control menu
This commit is contained in:
		
					parent
					
						
							
								4c0fb330eb
							
						
					
				
			
			
				commit
				
					
						09cbbaf537
					
				
			
		
					 8 changed files with 36 additions and 28 deletions
				
			
		|  | @ -13,7 +13,6 @@ import Assistant.WebApp.Types | ||||||
| import Assistant.Common | import Assistant.Common | ||||||
| import Utility.NotificationBroadcaster | import Utility.NotificationBroadcaster | ||||||
| import Utility.Yesod | import Utility.Yesod | ||||||
| import Locations.UserConfig |  | ||||||
| 
 | 
 | ||||||
| import Yesod | import Yesod | ||||||
| import Data.Text (Text) | import Data.Text (Text) | ||||||
|  | @ -24,11 +23,7 @@ inFirstRun :: Handler Bool | ||||||
| inFirstRun = isNothing . relDir <$> getYesod | inFirstRun = isNothing . relDir <$> getYesod | ||||||
| 
 | 
 | ||||||
| newWebAppState :: IO (TMVar WebAppState) | newWebAppState :: IO (TMVar WebAppState) | ||||||
| newWebAppState = do | newWebAppState = atomically $ newTMVar $ WebAppState { showIntro = True } | ||||||
| 	otherrepos <- listOtherRepos |  | ||||||
| 	atomically $ newTMVar $ WebAppState |  | ||||||
| 		{ showIntro = True |  | ||||||
| 		, otherRepos = otherrepos } |  | ||||||
| 
 | 
 | ||||||
| liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a | liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a | ||||||
| liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod | liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod | ||||||
|  | @ -102,15 +97,4 @@ redirectBack = do | ||||||
| 	redirectUltDest HomeR | 	redirectUltDest HomeR | ||||||
| 
 | 
 | ||||||
| controlMenu :: Widget | controlMenu :: Widget | ||||||
| controlMenu = do | controlMenu = $(widgetFile "controlmenu") | ||||||
| 	repolist <- lift $ otherRepos <$> getWebAppState |  | ||||||
| 	$(widgetFile "controlmenu") |  | ||||||
| 
 |  | ||||||
| listOtherRepos :: IO [(String, String)] |  | ||||||
| listOtherRepos = do |  | ||||||
| 	f <- autoStartFile |  | ||||||
| 	cwd <- getCurrentDirectory |  | ||||||
| 	dirs <- filter (\d -> not $ d `dirContains` cwd) . nub  |  | ||||||
| 		<$> ifM (doesFileExist f) ( lines <$> readFile f, return []) |  | ||||||
| 	names <- mapM relHome dirs |  | ||||||
| 	return $ sort $ zip names dirs |  | ||||||
|  |  | ||||||
|  | @ -148,8 +148,6 @@ getNewRepositoryR = page "Add another repository" (Just Configuration) $ do | ||||||
| 			u <- liftIO $ initRepo True path Nothing | 			u <- liftIO $ initRepo True path Nothing | ||||||
| 			runAnnex () $ setStandardGroup u ClientGroup | 			runAnnex () $ setStandardGroup u ClientGroup | ||||||
| 			liftIO $ addAutoStart path | 			liftIO $ addAutoStart path | ||||||
| 			otherrepos <- liftIO $ listOtherRepos |  | ||||||
| 			modifyWebAppState $ \s -> s { otherRepos = otherrepos } |  | ||||||
| 			redirect $ SwitchToRepositoryR path | 			redirect $ SwitchToRepositoryR path | ||||||
| 		_ -> $(widgetFile "configurators/newrepository") | 		_ -> $(widgetFile "configurators/newrepository") | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -11,15 +11,31 @@ module Assistant.WebApp.OtherRepos where | ||||||
| 
 | 
 | ||||||
| import Assistant.Common | import Assistant.Common | ||||||
| import Assistant.WebApp.Types | import Assistant.WebApp.Types | ||||||
|  | import Assistant.WebApp.Page | ||||||
| import qualified Git.Construct | import qualified Git.Construct | ||||||
| import qualified Git.Config | import qualified Git.Config | ||||||
| import Locations.UserConfig | import Locations.UserConfig | ||||||
| import qualified Utility.Url as Url | import qualified Utility.Url as Url | ||||||
|  | import Utility.Yesod | ||||||
| 
 | 
 | ||||||
| import Yesod | import Yesod | ||||||
| import Control.Concurrent | import Control.Concurrent | ||||||
| import System.Process (cwd) | import System.Process (cwd) | ||||||
| 
 | 
 | ||||||
|  | getRepositorySwitcherR :: Handler RepHtml | ||||||
|  | getRepositorySwitcherR = page "Switch repository" Nothing $ do | ||||||
|  | 	repolist <- liftIO listOtherRepos | ||||||
|  | 	$(widgetFile "control/repositoryswitcher") | ||||||
|  | 
 | ||||||
|  | listOtherRepos :: IO [(String, String)] | ||||||
|  | listOtherRepos = do | ||||||
|  | 	f <- autoStartFile | ||||||
|  | 	pwd <- getCurrentDirectory | ||||||
|  | 	dirs <- filter (\d -> not $ d `dirContains` pwd) . nub | ||||||
|  | 		<$> ifM (doesFileExist f) ( lines <$> readFile f, return []) | ||||||
|  | 	names <- mapM relHome dirs | ||||||
|  | 	return $ sort $ zip names dirs | ||||||
|  | 
 | ||||||
| {- Starts up the assistant in the repository, and waits for it to create | {- Starts up the assistant in the repository, and waits for it to create | ||||||
|  - a gitAnnexUrlFile. Waits for the assistant to be up and listening for |  - a gitAnnexUrlFile. Waits for the assistant to be up and listening for | ||||||
|  - connections by testing the url. Once it's running, redirect to it. |  - connections by testing the url. Once it's running, redirect to it. | ||||||
|  |  | ||||||
|  | @ -76,7 +76,6 @@ type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget) | ||||||
| 
 | 
 | ||||||
| data WebAppState = WebAppState | data WebAppState = WebAppState | ||||||
| 	{ showIntro :: Bool -- should the into message be displayed? | 	{ showIntro :: Bool -- should the into message be displayed? | ||||||
| 	, otherRepos :: [(String, String)] -- name and path to other repos |  | ||||||
| 	} | 	} | ||||||
| 
 | 
 | ||||||
| data RepoSelector = RepoSelector | data RepoSelector = RepoSelector | ||||||
|  |  | ||||||
|  | @ -15,6 +15,7 @@ | ||||||
| 
 | 
 | ||||||
| /config/repository/new/first FirstRepositoryR GET | /config/repository/new/first FirstRepositoryR GET | ||||||
| /config/repository/new NewRepositoryR GET | /config/repository/new NewRepositoryR GET | ||||||
|  | /config/repository/switcher RepositorySwitcherR GET | ||||||
| /config/repository/switchto/#FilePath SwitchToRepositoryR GET | /config/repository/switchto/#FilePath SwitchToRepositoryR GET | ||||||
| /config/repository/edit/#UUID EditRepositoryR GET | /config/repository/edit/#UUID EditRepositoryR GET | ||||||
| /config/repository/edit/new/#UUID EditNewRepositoryR GET | /config/repository/edit/new/#UUID EditNewRepositoryR GET | ||||||
|  |  | ||||||
										
											Binary file not shown.
										
									
								
							| Before Width: | Height: | Size: 7.5 KiB After Width: | Height: | Size: 8.7 KiB | 
							
								
								
									
										14
									
								
								templates/control/repositoryswitcher.hamlet
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										14
									
								
								templates/control/repositoryswitcher.hamlet
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,14 @@ | ||||||
|  | <div .span9 .hero-unit> | ||||||
|  |   <h2> | ||||||
|  |     Switch repository | ||||||
|  |   <p> | ||||||
|  |     $if null repolist | ||||||
|  |       There are no other local repositories. Want to # | ||||||
|  |       <a href="@{NewRepositoryR}">add one</a>? | ||||||
|  |     $else | ||||||
|  |       You can switch to any of these other local repositories: | ||||||
|  |       <ul> | ||||||
|  |         $forall (name, path) <- repolist | ||||||
|  |           <li> | ||||||
|  |             <a href="@{SwitchToRepositoryR path}"> | ||||||
|  |               #{name} | ||||||
|  | @ -1,12 +1,8 @@ | ||||||
| <ul .dropdown-menu> | <ul .dropdown-menu> | ||||||
|   $forall (name, path) <- repolist |  | ||||||
|     <li> |  | ||||||
|       <a href="@{SwitchToRepositoryR path}"> |  | ||||||
|         <i .icon-folder-close></i> #{name} |  | ||||||
|   $if not (null repolist) |  | ||||||
|     <li .divider></li> |  | ||||||
|   <li> |   <li> | ||||||
|     <a href="@{NewRepositoryR}"> |     <a href="@{NewRepositoryR}"> | ||||||
|       <i .icon-plus-sign></i> Add another repository |       <i .icon-plus-sign></i> Add another local repository | ||||||
|  |     <a href="@{RepositorySwitcherR}"> | ||||||
|  |       <i .icon-folder-close></i> Switch repository | ||||||
|     <a href="@{ShutdownR}"> |     <a href="@{ShutdownR}"> | ||||||
|       <i .icon-off></i> Shut down |       <i .icon-off></i> Shut down | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess