webapp: Repository list is now included in the dashboard, and other UI tweaks.

Assistant/WebApp/Configurators.hs

@@ -29,31 +29,11 @@ getConfigurationR = ifM (inFirstRun)
 		$(widgetFile "configurators/main")
 	)
 
-{- An intro message, list of repositories, and nudge to make more. -}
-introDisplay :: Text -> Widget
-introDisplay ident = do
-	webapp <- lift getYesod
-	repolist <- lift $ repoList $ RepoSelector
-		{ onlyCloud = False
-		, onlyConfigured = True
-		, includeHere = False
-		}
-	let n = length repolist
-	let numrepos = show n
-	$(widgetFile "configurators/intro")
-	lift $ modifyWebAppState $ \s -> s { showIntro = False }
-
-{- Lists known repositories, followed by options to add more. -}
-getRepositoriesR :: Handler RepHtml
-getRepositoriesR = page "Repositories" (Just Repositories) $ do
-	let repolist = repoListDisplay $ RepoSelector
-		{ onlyCloud = False
-		, onlyConfigured = False
-		, includeHere = True
-		}
+getAddRepositoryR :: Handler RepHtml
+getAddRepositoryR = page "Add Repository" (Just Configuration) $ do
+	let repolist = repoListDisplay mainRepoSelector
 	$(widgetFile "configurators/repositories")
 
-
 makeMiscRepositories :: Widget
 makeMiscRepositories = $(widgetFile "configurators/repositories/misc")
 

Assistant/WebApp/Configurators/Edit.hs

@@ -128,7 +128,7 @@ editForm new uuid = page "Configure repository" (Just Configuration) $ do
 		FormSuccess input -> lift $ do
 			checkarchivedirectory input
 			setRepoConfig uuid mremote curr input
-			redirect RepositoriesR
+			redirect DashboardR
 		_ -> showform form enctype curr
   where
 	showform form enctype curr = do

Assistant/WebApp/Configurators/Pairing.hs

@@ -156,6 +156,7 @@ xmppPairEnd inprogress theirjid = pairPage $ do
 		{ onlyCloud = True
 		, onlyConfigured = False
 		, includeHere = False
+		, nudgeAddMore = False
 		}
 	$(widgetFile "configurators/pairing/xmpp/end")
 #endif

Assistant/WebApp/DashBoard.hs

@@ -11,8 +11,8 @@ module Assistant.WebApp.DashBoard where
 
 import Assistant.WebApp.Common
 import Assistant.WebApp.Utility
+import Assistant.WebApp.RepoList
 import Assistant.WebApp.Notifications
-import Assistant.WebApp.Configurators
 import Assistant.TransferQueue
 import Utility.NotificationBroadcaster
 import Logs.Transfer
@@ -36,12 +36,7 @@ transfersDisplay warnNoScript = do
 	queued <- lift $ take 10 <$> liftAssistant getTransferQueue
 	autoUpdate ident NotifierTransfersR (10 :: Int) (10 :: Int)
 	let transfers = simplifyTransfers $ current ++ queued
-	if null transfers
-		then ifM (lift $ showIntro <$> getWebAppState)
-			( introDisplay ident
-			, $(widgetFile "dashboard/transfers")
-			)
-		else $(widgetFile "dashboard/transfers")
+	$(widgetFile "dashboard/transfers")
   where
 	ident = "transfers"
 	isrunning info = not $
@@ -74,7 +69,9 @@ getTransfersR nid = do
 {- The main dashboard. -}
 dashboard :: Bool -> Widget
 dashboard warnNoScript = do
-	let content = transfersDisplay warnNoScript
+	let repolist = repoListDisplay $
+		mainRepoSelector { nudgeAddMore = True }
+	let transferlist = transfersDisplay warnNoScript
 	$(widgetFile "dashboard/main")
 
 getDashboardR :: Handler RepHtml

Assistant/WebApp/Page.hs

@@ -19,18 +19,16 @@ import Yesod
 import Text.Hamlet
 import Data.Text (Text)
 
-data NavBarItem = DashBoard | Repositories | Configuration | About
+data NavBarItem = DashBoard | Configuration | About
 	deriving (Eq, Ord, Enum, Bounded)
 
 navBarName :: NavBarItem -> Text
 navBarName DashBoard = "Dashboard"
-navBarName Repositories = "Repositories"
 navBarName Configuration = "Configuration"
 navBarName About = "About"
 
 navBarRoute :: NavBarItem -> Route WebApp
 navBarRoute DashBoard = DashboardR
-navBarRoute Repositories = RepositoriesR
 navBarRoute Configuration = ConfigurationR
 navBarRoute About = AboutR
 

Assistant/WebApp/RepoList.hs

@@ -63,7 +63,7 @@ notSyncing (SyncingRepoActions _ _) = False
 notSyncing _ = True
 
 {- Called by client to get a list of repos, that refreshes
- - when new repos as added.
+ - when new repos are added.
  -
  - Returns a div, which will be inserted into the calling page.
  -}
@@ -73,6 +73,14 @@ getRepoListR (RepoListNotificationId nid reposelector) = do
 	p <- widgetToPageContent $ repoListDisplay reposelector
 	hamletToRepHtml $ [hamlet|^{pageBody p}|]
 
+mainRepoSelector :: RepoSelector
+mainRepoSelector = RepoSelector
+	{ onlyCloud = False
+	, onlyConfigured = False
+	, includeHere = True
+	, nudgeAddMore = False
+	}
+
 repoListDisplay :: RepoSelector -> Widget
 repoListDisplay reposelector = do
 	autoUpdate ident (NotifierRepoListR reposelector) (10 :: Int) (10 :: Int)
@@ -82,17 +90,16 @@ repoListDisplay reposelector = do
 	addScript $ StaticR jquery_ui_sortable_js
 
 	repolist <- lift $ repoList reposelector
+	let addmore = nudgeAddMore reposelector
+	let nootherrepos = length repolist < 2
 
 	$(widgetFile "repolist")
-
   where
 	ident = "repolist"
 
--- (num, name, uuid, actions)
-type RepoList = [(String, String, UUID, Actions)]
+type RepoList = [(String, UUID, Actions)]
 
-{- A numbered list of known repositories,
- - with actions that can be taken on them. -}
+{- A list of known repositories, with actions that can be taken on them. -}
 repoList :: RepoSelector -> Handler RepoList
 repoList reposelector
 	| onlyConfigured reposelector = list =<< configured
@@ -149,12 +156,10 @@ repoList reposelector
 		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
 	list l = liftAnnex $ do
 		let l' = nubBy (\x y -> fst x == fst y) l
-		l'' <- zip3
-			<$> pure counter
-			<*> Remote.prettyListUUIDs (map fst l')
+		l'' <- zip
+			<$> Remote.prettyListUUIDs (map fst l')
 			<*> pure l'
-		return $ map (\(num, name, (uuid, actions)) -> (num, name, uuid, actions)) l''
-	counter = map show ([1..] :: [Int])
+		return $ map (\(name, (uuid, actions)) -> (name, uuid, actions)) l''
 
 getEnableSyncR :: UUID -> Handler ()
 getEnableSyncR = flipSync True
@@ -166,7 +171,7 @@ flipSync :: Bool -> UUID -> Handler ()
 flipSync enable uuid = do
 	mremote <- liftAnnex $ Remote.remoteFromUUID uuid
 	changeSyncable mremote enable
-	redirect RepositoriesR
+	redirectBack
 
 getRepositoriesReorderR :: Handler ()
 getRepositoriesReorderR = do

Assistant/WebApp/Types.hs

@@ -83,6 +83,7 @@ data RepoSelector = RepoSelector
 	{ onlyCloud :: Bool
 	, onlyConfigured :: Bool
 	, includeHere :: Bool
+	, nudgeAddMore :: Bool
 	}
 	deriving (Read, Show, Eq)
 

Assistant/WebApp/routes

@@ -1,8 +1,5 @@
 / DashboardR GET HEAD
 
-/repositories RepositoriesR GET
-/repositories/reorder RepositoriesReorderR GET
-
 /noscript NoScriptR GET
 /noscript/auto NoScriptAutoR GET
 
@@ -20,6 +17,7 @@
 /config/preferences PreferencesR GET
 /config/xmpp XMPPR GET
 
+/config/addrepository AddRepositoryR GET
 /config/repository/new/first FirstRepositoryR GET
 /config/repository/new NewRepositoryR GET
 /config/repository/switcher RepositorySwitcherR GET
@@ -55,6 +53,8 @@
 /config/repository/enable/glacier/#UUID EnableGlacierR GET
 /config/repository/enable/webdav/#UUID EnableWebDAVR GET
 
+/config/repository/reorder RepositoriesReorderR GET
+
 /transfers/#NotificationId TransfersR GET
 /notifier/transfers NotifierTransfersR GET