moving toward configuring new repos in the webapp

Assistant/WebApp/Configurators.hs

@@ -30,25 +30,51 @@ import qualified Data.Text as T
 import Data.Char
 import System.Posix.Directory
 
-{- An intro message, list of repositories, and nudge to make more. -}
+{- The main configuration screen. -}
-introDisplay :: Text -> Widget
+getConfigR :: Handler RepHtml
-introDisplay ident = do
+getConfigR = ifM (inFirstRun)
-	webapp <- lift getYesod
+	( getFirstRepositoryR
-	l <- lift $ runAnnex [] $ do
+	, bootstrap (Just Config) $ do
+		sideBarDisplay $ Just sidebar
+		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
+	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)
+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 remotelist = zip counter l
 	let n = length l
-	let numrepos = show n
+	return (zip counter l, show (length l), n < enough, n == enough, n > enough)
-	let notenough = n < 2
-	let barelyenough = n == 2
-	let morethanenough = n > 2
-	$(widgetFile "configurators/intro")
-	lift $ modifyWebAppState $ \s -> s { showIntro = False }
 	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
+	$(widgetFile "configurators/intro")
+	lift $ modifyWebAppState $ \s -> s { showIntro = False }
 
 data RepositoryPath = RepositoryPath Text
 	deriving Show
@@ -118,8 +144,8 @@ defaultRepositoryPath firstrun = do
 				(relHome (desktop </> "annex"), return "~/annex")
 		else return cwd
 
-addRepositoryForm :: Form RepositoryPath
+addLocalRepositoryForm :: Form RepositoryPath
-addRepositoryForm msg = do
+addLocalRepositoryForm msg = do
 	path <- T.pack . addTrailingPathSeparator
 		<$> (liftIO . defaultRepositoryPath =<< lift inFirstRun)
 	(pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path)
@@ -129,20 +155,18 @@ addRepositoryForm msg = do
 		FormSuccess _ -> (False, "")
 	let form = do
 		webAppFormAuthToken
-		$(widgetFile "configurators/addrepository/form")
+		$(widgetFile "configurators/localrepositoryform")
 	return (RepositoryPath <$> pathRes, form)
 
-addRepository :: Bool -> Widget
+getFirstRepositoryR :: Handler RepHtml
-addRepository firstrun = do
+getFirstRepositoryR = bootstrap (Just Config) $ do
-	setTitle $ if firstrun then "Getting started" else "Add repository"
+	sideBarDisplay Nothing
-	((res, form), enctype) <- lift $ runFormGet addRepositoryForm
+	setTitle "Getting started"
+	((res, form), enctype) <- lift $ runFormGet addLocalRepositoryForm
 	case res of
-		FormSuccess (RepositoryPath p) -> go $ T.unpack p
+		FormSuccess (RepositoryPath p) -> lift $
-		_ -> $(widgetFile "configurators/addrepository")
+			startFullAssistant $ T.unpack p
-	where
+		_ -> $(widgetFile "configurators/firstrepository")
-		go path
-			| firstrun = lift $ startFullAssistant path
-			| otherwise = error "TODO"
 
 {- Bootstraps from first run mode to a fully running assistant in a
  - repository, by running the postFirstRun callback, which returns the
@@ -167,18 +191,3 @@ makeRepo path = do
 	autostart <- autoStartFile
 	createDirectoryIfMissing True (parentDir autostart)
 	appendFile autostart $ path ++ "\n"
-
-getAddRepositoryR :: Handler RepHtml
-getAddRepositoryR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	addRepository False
-
-getConfigR :: Handler RepHtml
-getConfigR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	ifM (lift inFirstRun)
-		( addRepository True
-		, do
-			setTitle "Configuration"
-			$(widgetFile "configurators/main")
-		)

Assistant/WebApp/DashBoard.hs

@@ -68,7 +68,7 @@ getTransfersR nid = do
 {- The main dashboard. -}
 dashboard :: Bool -> Widget
 dashboard warnNoScript = do
-	sideBarDisplay
+	sideBarDisplay Nothing
 	let content = transfersDisplay warnNoScript
 	$(widgetFile "dashboard/main")
 

Assistant/WebApp/Documentation.hs

@@ -17,6 +17,6 @@ import Yesod
 
 getAboutR :: Handler RepHtml
 getAboutR = bootstrap (Just About) $ do
-	sideBarDisplay
+	sideBarDisplay Nothing
 	setTitle "About git-annex"
 	$(widgetFile "documentation/about")

Assistant/WebApp/SideBar.hs

@@ -22,9 +22,13 @@ import Data.Text (Text)
 import qualified Data.Map as M
 import Control.Concurrent
 
-sideBarDisplay :: Widget
+sideBarDisplay :: Maybe Widget -> Widget
-sideBarDisplay = do
+sideBarDisplay onsidebar = do
 	let content = do
+		{- If a widget was passed to include on the sidebar, display
+		 - it above alerts. -}
+		maybe noop id onsidebar
+
 		{- Any yesod message appears as the first alert. -}
 		maybe noop rendermessage =<< lift getMessage
 	
@@ -83,7 +87,7 @@ getSideBarR nid = do
 	 - to avoid slowing down user actions like closing alerts. -}
 	liftIO $ threadDelay 100000
 
-	page <- widgetToPageContent sideBarDisplay
+	page <- widgetToPageContent $ sideBarDisplay Nothing
 	hamletToRepHtml $ [hamlet|^{pageBody page}|]
 
 {- Called by the client to close an alert. -}

Assistant/WebApp/routes

@@ -5,6 +5,7 @@
 
 /config ConfigR GET
 /config/addrepository AddRepositoryR GET
+/config/firstrepository FirstRepositoryR GET
 
 /transfers/#NotificationId TransfersR GET
 /sidebar/#NotificationId SideBarR GET

templates/configurators/addrepository.hamlet

@@ -1,15 +1,10 @@
-<div .span9 .hero-unit>
+<div .row-fluid>
-    $if firstrun
+  <div .span4>
-      <h2>
+    <h3>
-        Welcome to git-annex!
+      Clone to removable drive
-        <p>
-          There's just one thing to do before you can start using the power #
-          and convenience of git-annex.
-    <h2>
-      Create a git-annex repository
     <p>
-      Files in this repository will managed by git-annex, #
+      Clone this repository to a USB drive, or other removable media, #
-      and kept in sync with your repositories on other devices.
+      for offline archiving, backups, or to #
-    <p>
+      <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #
-    <form .form-inline enctype=#{enctype}>
+      between computers.
-      ^{form}
+    

templates/configurators/firstrepository.hamlet

@@ -0,0 +1,14 @@
+<div .span9 .hero-unit>
+    <h2>
+      Welcome to git-annex!
+      <p>
+        There's just one thing to do before you can start using the power #
+        and convenience of git-annex.
+    <h2>
+      Create a git-annex repository
+    <p>
+      Files in this repository will managed by git-annex, #
+      and kept in sync with your repositories on other devices.
+    <p>
+    <form .form-inline enctype=#{enctype}>
+      ^{form}

templates/configurators/intro.hamlet

@@ -17,7 +17,7 @@
         \ repositories and devices:
         <table .table .table-striped .table-condensed>
           <tbody>
-            $forall (num, name) <- remotelist
+            $forall (num, name) <- repolist
               <tr>
                 <td>
                   #{num}

templates/configurators/main.hamlet

@@ -1,3 +1,42 @@
-<div .span9 .hero-unit>
+<div .span9>
-  <h2>
+  <div .row-fluid>
-    Sorry, no configuration is implemented yet...
+    <div .span4>
+      <h3>
+        <a href="">
+          Clone to removable drive
+      <p>
+        Clone this repository to a USB drive, memory stick, or other #
+        removable media.
+      <p>
+        For offline archiving, backups, or to #
+        <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> #
+        between computers. 
+    <div .span4>
+      <h3>
+        <a href="">
+          Clone to a local computer
+      <p>
+        Automatically keep files in sync between computers on your #
+        local network.
+      <p>
+        For easy sharing with family and friends, or between your devices.
+    <div .span4>
+  <div .row-fluid>
+    <div .span4>
+      <h3>
+        <a href="">
+          Store data in the cloud
+      <p>
+        Store your data on a third-party cloud platform, #
+        including Amazon S3, Box.com, and Rsync.net.
+      <p>
+        Pay someone to keep your data safe. With strong encryption to #
+        protect your privacy.
+    <div .span4>
+      <h3>
+        <a href="">
+          Clone to a remote server
+      <p>
+        Set up a repository on a remote Unix server running SSH.
+      <p>
+        For when you want to run your own cloud.

templates/configurators/main/sidebar.hamlet

@@ -0,0 +1,18 @@
+<div .alert .alert-info>
+  <h4 .alert-heading>
+    git-annex is managing #
+    $if notenough
+      only #
+      <span .badge .badge-error>#{numrepos}</span> repository. #
+    $else
+      $if barelyenough
+        <span .badge .badge-warning>#{numrepos}</span> repositories. #
+      $else
+        <span .badge .badge-success>#{numrepos}</span> repositories. #
+  $if notenough
+    Recommend you add more clones to avoid data loss.
+  $else
+    $if barelyenough
+      Consider adding more.
+    $else
+      Adding more can't hurt!

templates/documentation/about.hamlet

@@ -10,8 +10,8 @@
   <hr>
     git-annex is © 2010-2012 Joey Hess. It is free software, licensed #
     under the terms of the GNU General Public License, version 3 or above. #
-    <br>
+    <p>
-    <i class="icon-heart"></i> Its development was made possible by #
+    Its development was made possible by #
     <a href="http://git-annex.branchable.com/design/assistant/thanks/">
       many excellent people
-    .
+    . <i class="icon-heart"></i>

templates/sidebar/alert.hamlet

@@ -7,7 +7,7 @@
       <i class="icon-#{name}"></i> #
   $maybe h <- heading
     $if block
-      <h4 class="alert-heading">#{h}</h4> #
+      <h4 .alert-heading>#{h}</h4> #
     $else
       <strong>#{h}</strong> #
   ^{widget}