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 Utility.NotificationBroadcaster
 | 
			
		||||
import Utility.Yesod
 | 
			
		||||
import Locations.UserConfig
 | 
			
		||||
 | 
			
		||||
import Yesod
 | 
			
		||||
import Data.Text (Text)
 | 
			
		||||
| 
						 | 
				
			
			@ -24,11 +23,7 @@ inFirstRun :: Handler Bool
 | 
			
		|||
inFirstRun = isNothing . relDir <$> getYesod
 | 
			
		||||
 | 
			
		||||
newWebAppState :: IO (TMVar WebAppState)
 | 
			
		||||
newWebAppState = do
 | 
			
		||||
	otherrepos <- listOtherRepos
 | 
			
		||||
	atomically $ newTMVar $ WebAppState
 | 
			
		||||
		{ showIntro = True
 | 
			
		||||
		, otherRepos = otherrepos }
 | 
			
		||||
newWebAppState = atomically $ newTMVar $ WebAppState { showIntro = True }
 | 
			
		||||
 | 
			
		||||
liftAssistant :: forall sub a. (Assistant a) -> GHandler sub WebApp a
 | 
			
		||||
liftAssistant a = liftIO . flip runAssistant a =<< assistantData <$> getYesod
 | 
			
		||||
| 
						 | 
				
			
			@ -102,15 +97,4 @@ redirectBack = do
 | 
			
		|||
	redirectUltDest HomeR
 | 
			
		||||
 | 
			
		||||
controlMenu :: Widget
 | 
			
		||||
controlMenu = do
 | 
			
		||||
	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
 | 
			
		||||
controlMenu = $(widgetFile "controlmenu")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -148,8 +148,6 @@ getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
 | 
			
		|||
			u <- liftIO $ initRepo True path Nothing
 | 
			
		||||
			runAnnex () $ setStandardGroup u ClientGroup
 | 
			
		||||
			liftIO $ addAutoStart path
 | 
			
		||||
			otherrepos <- liftIO $ listOtherRepos
 | 
			
		||||
			modifyWebAppState $ \s -> s { otherRepos = otherrepos }
 | 
			
		||||
			redirect $ SwitchToRepositoryR path
 | 
			
		||||
		_ -> $(widgetFile "configurators/newrepository")
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -11,15 +11,31 @@ module Assistant.WebApp.OtherRepos where
 | 
			
		|||
 | 
			
		||||
import Assistant.Common
 | 
			
		||||
import Assistant.WebApp.Types
 | 
			
		||||
import Assistant.WebApp.Page
 | 
			
		||||
import qualified Git.Construct
 | 
			
		||||
import qualified Git.Config
 | 
			
		||||
import Locations.UserConfig
 | 
			
		||||
import qualified Utility.Url as Url
 | 
			
		||||
import Utility.Yesod
 | 
			
		||||
 | 
			
		||||
import Yesod
 | 
			
		||||
import Control.Concurrent
 | 
			
		||||
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
 | 
			
		||||
 - a gitAnnexUrlFile. Waits for the assistant to be up and listening for
 | 
			
		||||
 - 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
 | 
			
		||||
	{ showIntro :: Bool -- should the into message be displayed?
 | 
			
		||||
	, otherRepos :: [(String, String)] -- name and path to other repos
 | 
			
		||||
	}
 | 
			
		||||
 | 
			
		||||
data RepoSelector = RepoSelector
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -15,6 +15,7 @@
 | 
			
		|||
 | 
			
		||||
/config/repository/new/first FirstRepositoryR GET
 | 
			
		||||
/config/repository/new NewRepositoryR GET
 | 
			
		||||
/config/repository/switcher RepositorySwitcherR GET
 | 
			
		||||
/config/repository/switchto/#FilePath SwitchToRepositoryR GET
 | 
			
		||||
/config/repository/edit/#UUID EditRepositoryR 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>
 | 
			
		||||
  $forall (name, path) <- repolist
 | 
			
		||||
    <li>
 | 
			
		||||
      <a href="@{SwitchToRepositoryR path}">
 | 
			
		||||
        <i .icon-folder-close></i> #{name}
 | 
			
		||||
  $if not (null repolist)
 | 
			
		||||
    <li .divider></li>
 | 
			
		||||
  <li>
 | 
			
		||||
    <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}">
 | 
			
		||||
      <i .icon-off></i> Shut down
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue