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