made navbar work

also added an About page and a stub Config page.

Assistant/Threads/WebApp.hs

@@ -16,6 +16,7 @@ import Assistant.WebApp.DashBoard
 import Assistant.WebApp.SideBar
 import Assistant.WebApp.Notifications
 import Assistant.WebApp.Configurators
+import Assistant.WebApp.Documentation
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue

Assistant/WebApp.hs

@@ -39,8 +39,28 @@ data WebApp = WebApp
 	, webAppState :: TMVar WebAppState
 	}
 
-instance Yesod WebApp where
-	defaultLayout content = do
+data NavBarItem = DashBoard | Config | About
+	deriving (Eq)
+
+navBarName :: NavBarItem -> Text
+navBarName DashBoard = "Dashboard"
+navBarName Config = "Configuration"
+navBarName About = "About"
+
+navBarRoute :: NavBarItem -> Route WebApp
+navBarRoute DashBoard = HomeR
+navBarRoute Config = ConfigR
+navBarRoute About = AboutR
+
+navBar :: Maybe NavBarItem -> [(Text, Route WebApp, Bool)]
+navBar r = map details [DashBoard, Config, About]
+	where
+		details i = (navBarName i, navBarRoute i, Just i == r)
+
+{- Used instead of defaultContent; highlights the current page if it's
+ - on the navbar. -}
+bootstrap :: Maybe NavBarItem -> Widget -> Handler RepHtml
+bootstrap navbaritem content = do
 	webapp <- getYesod
 	page <- widgetToPageContent $ do
 		addStylesheet $ StaticR css_bootstrap_css
@@ -48,9 +68,11 @@ instance Yesod WebApp where
 		addScript $ StaticR jquery_full_js
 		addScript $ StaticR js_bootstrap_dropdown_js
 		addScript $ StaticR js_bootstrap_modal_js
+		let navbar = navBar navbaritem
 		$(widgetFile "page")
 	hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap")
 
+instance Yesod WebApp where
 	{- Require an auth token be set when accessing any (non-static route) -}
 	isAuthorized _ _ = checkAuthToken secretToken
 

Assistant/WebApp/Configurators.hs

@@ -44,13 +44,12 @@ introDisplay ident = do
 		counter = map show ([1..] :: [Int])
 
 getConfigR :: Handler RepHtml
-getConfigR = defaultLayout $ do
+getConfigR = bootstrap (Just Config) $ do
 	sideBarDisplay
 	setTitle "Configuration"
-	[whamlet|<a href="@{HomeR}">main|]
+	$(widgetFile "configurators/main")
 
 getAddRepositoryR :: Handler RepHtml
-getAddRepositoryR = defaultLayout $ do
+getAddRepositoryR = bootstrap (Just Config) $ do
 	sideBarDisplay
 	setTitle "Add repository"
-	[whamlet|<a href="@{HomeR}">main|]

Assistant/WebApp/DashBoard.hs

@@ -72,18 +72,17 @@ dashboard warnNoScript = do
 	$(widgetFile "dashboard/main")
 
 getHomeR :: Handler RepHtml
-getHomeR = defaultLayout $ dashboard True
+getHomeR = bootstrap (Just DashBoard) $ dashboard True
+
+{- Same as HomeR, except no autorefresh at all (and no noscript warning). -}
+getNoScriptR :: Handler RepHtml
+getNoScriptR = bootstrap (Just DashBoard)  $ dashboard False
 
 {- Same as HomeR, except with autorefreshing via meta refresh. -}
 getNoScriptAutoR :: Handler RepHtml
-getNoScriptAutoR = defaultLayout $ do
+getNoScriptAutoR = bootstrap (Just DashBoard) $ do
 	let ident = NoScriptR
 	let delayseconds = 3 :: Int
 	let this = NoScriptAutoR
 	toWidgetHead $(hamletFile $ hamletTemplate "dashboard/metarefresh")
 	dashboard False
-
-{- Same as HomeR, except no autorefresh at all (and no noscript warning). -}
-getNoScriptR :: Handler RepHtml
-getNoScriptR = defaultLayout $
-	dashboard False

Assistant/WebApp/Documentation.hs

@@ -0,0 +1,22 @@
+{- git-annex assistant webapp documentation
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+
+module Assistant.WebApp.Documentation where
+
+import Assistant.WebApp
+import Assistant.WebApp.SideBar
+import Utility.Yesod
+
+import Yesod
+
+getAboutR :: Handler RepHtml
+getAboutR = bootstrap (Just About) $ do
+	sideBarDisplay
+	setTitle "About git-annex"
+	$(widgetFile "documentation/about")

Assistant/WebApp/routes

@@ -3,6 +3,7 @@
 /noscriptauto NoScriptAutoR GET
 /config ConfigR GET
 /addrepository AddRepositoryR GET
+/about AboutR GET
 
 /transfers/#NotificationId TransfersR GET
 /sidebar/#NotificationId SideBarR GET

templates/bootstrap.hamlet

@@ -7,3 +7,4 @@ $doctype 5
     ^{pageHead page}
   <body>
     ^{pageBody page}
+    <div #modal></div>

templates/configurators/main.hamlet

@@ -0,0 +1,3 @@
+<div .span9 .hero-unit>
+  <h2>
+    Sorry, no configuration is implemented yet...

templates/documentation/about.hamlet

@@ -0,0 +1,16 @@
+<div .span9 .hero-unit>
+  <h2>
+    git-annex watches over your files
+  <p>
+    It will automatically notice changes, and keep files in sync between #
+    repositories and devices.
+  <p>
+    For full details, see #
+    <a href="http://git-annex.branchable.com/">the git-annex website</a>.
+  <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. #
+    Its development was made possible by #
+    <a href="http://git-annex.branchable.com/design/assistant/thanks/">
+      many excellent people
+    .

templates/page.hamlet

@@ -4,10 +4,9 @@
       <a .brand href="#">
         git-annex
       <ul .nav>
-        <li .active>
-          <a href="#">Dashboard</a>
-        <li>
-          <a href="@{ConfigR}">Config</a>
+        $forall (name, route, isactive) <- navbar
+          <li :isactive:.active>
+            <a href="@{route}">#{name}</a>
       <ul .nav .pull-right>
         <li .dropdown #menu1>
           <a .dropdown-toggle data-toggle="dropdown" href="#menu1">
@@ -21,4 +20,3 @@
 <div .container-fluid>
   <div .row-fluid>
     ^{content}
-<div #modal></div>