diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-03 20:40:34 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-03 20:40:34 -0400 |
commit | e0c3958d9acc97c15a209c287c1d49e859ca4fea (patch) | |
tree | 0f443081923c4e460af596b0ad2b773b435b72d1 /Assistant/WebApp | |
parent | 1bd2be549f0736340b09cc056ce9d7c1db6b928c (diff) |
improved config
Diffstat (limited to 'Assistant/WebApp')
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 38 | ||||
-rw-r--r-- | Assistant/WebApp/DashBoard.hs | 2 | ||||
-rw-r--r-- | Assistant/WebApp/Documentation.hs | 2 | ||||
-rw-r--r-- | Assistant/WebApp/SideBar.hs | 9 | ||||
-rw-r--r-- | Assistant/WebApp/routes | 7 |
5 files changed, 31 insertions, 27 deletions
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 018f97363..2771a2284 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -35,46 +35,52 @@ getConfigR :: Handler RepHtml getConfigR = ifM (inFirstRun) ( getFirstRepositoryR , bootstrap (Just Config) $ do - sideBarDisplay $ Just sidebar + sideBarDisplay setTitle "Configuration" $(widgetFile "configurators/main") ) - where - sidebar = do - (_repolist, numrepos, notenough, barelyenough, morethanenough) - <- lift repoList - $(widgetFile "configurators/main/sidebar") {- Lists different types of repositories that can be added. -} getAddRepositoryR :: Handler RepHtml getAddRepositoryR = bootstrap (Just Config) $ do - sideBarDisplay Nothing + sideBarDisplay setTitle "Add repository" $(widgetFile "configurators/addrepository") -{- A numbered list of known repositories, including the current one, - - as well as the total number, and whether that is not enough, - - barely enough, or more than enough. -} -repoList :: Handler ([(String, String)], String, Bool, Bool, Bool) +{- Lists known repositories. -} +getListRepositoriesR :: Handler RepHtml +getListRepositoriesR = bootstrap (Just Config) $ do + sideBarDisplay + setTitle "Repository list" + repolist <- lift repoList + $(widgetFile "configurators/listrepositories") + +{- A numbered list of known repositories, including the current one. -} +repoList :: Handler [(String, String)] repoList = do l <- runAnnex [] $ do u <- getUUID rs <- map Remote.uuid <$> Remote.remoteList rs' <- snd <$> trustPartition DeadTrusted rs Remote.prettyListUUIDs $ filter (/= webUUID) $ nub $ u:rs' - let n = length l - return (zip counter l, show (length l), n < enough, n == enough, n > enough) + return $ zip counter l where counter = map show ([1..] :: [Int]) - enough = 2 {- An intro message, list of repositories, and nudge to make more. -} introDisplay :: Text -> Widget introDisplay ident = do webapp <- lift getYesod - (repolist, numrepos, notenough, barelyenough, morethanenough) <- lift repoList + repolist <- lift repoList + let n = length repolist + let numrepos = show n + let notenough = n < enough + let barelyenough = n == enough + let morethanenough = n > enough $(widgetFile "configurators/intro") lift $ modifyWebAppState $ \s -> s { showIntro = False } + where + enough = 2 data RepositoryPath = RepositoryPath Text deriving Show @@ -160,7 +166,7 @@ addLocalRepositoryForm msg = do getFirstRepositoryR :: Handler RepHtml getFirstRepositoryR = bootstrap (Just Config) $ do - sideBarDisplay Nothing + sideBarDisplay setTitle "Getting started" ((res, form), enctype) <- lift $ runFormGet addLocalRepositoryForm case res of diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 32159c22d..8e526fb1d 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -68,7 +68,7 @@ getTransfersR nid = do {- The main dashboard. -} dashboard :: Bool -> Widget dashboard warnNoScript = do - sideBarDisplay Nothing + sideBarDisplay let content = transfersDisplay warnNoScript $(widgetFile "dashboard/main") diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs index 530c4ceb3..b0a9e4d98 100644 --- a/Assistant/WebApp/Documentation.hs +++ b/Assistant/WebApp/Documentation.hs @@ -17,6 +17,6 @@ import Yesod getAboutR :: Handler RepHtml getAboutR = bootstrap (Just About) $ do - sideBarDisplay Nothing + sideBarDisplay setTitle "About git-annex" $(widgetFile "documentation/about") diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs index 2fbd4e8c0..4373b5a5b 100644 --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -22,11 +22,8 @@ import Data.Text (Text) import qualified Data.Map as M import Control.Concurrent -sideBarDisplay :: Maybe Widget -> Widget -sideBarDisplay onsidebar = do - {- If a widget was passed to include on the sidebar, display - - it above alerts. -} - let perpage = maybe noop id onsidebar +sideBarDisplay :: Widget +sideBarDisplay = do let content = do {- Any yesod message appears as the first alert. -} maybe noop rendermessage =<< lift getMessage @@ -86,7 +83,7 @@ getSideBarR nid = do - to avoid slowing down user actions like closing alerts. -} liftIO $ threadDelay 100000 - page <- widgetToPageContent $ sideBarDisplay Nothing + page <- widgetToPageContent sideBarDisplay hamletToRepHtml $ [hamlet|^{pageBody page}|] {- Called by the client to close an alert. -} diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 893ba79fe..12b9564ee 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -1,11 +1,12 @@ / HomeR GET /noscript NoScriptR GET -/noscriptauto NoScriptAutoR GET +/noscript/auto NoScriptAutoR GET /about AboutR GET /config ConfigR GET -/config/addrepository AddRepositoryR GET -/config/firstrepository FirstRepositoryR GET +/config/repository/add AddRepositoryR GET +/config/repository/first FirstRepositoryR GET +/config/repository/list ListRepositoriesR GET /transfers/#NotificationId TransfersR GET /sidebar/#NotificationId SideBarR GET |