move local repo list out of control menu

This commit is contained in:
Joey Hess 2013-01-03 16:34:57 -04:00
parent 4c0fb330eb
commit 09cbbaf537
8 changed files with 36 additions and 28 deletions

View file

@ -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

View file

@ -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")

View file

@ -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.

View file

@ -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

View file

@ -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

View 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}

View file

@ -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