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…
Reference in a new issue