made navbar work
also added an About page and a stub Config page.
This commit is contained in:
parent
5fed026bcd
commit
2c8bbdf307
10 changed files with 89 additions and 27 deletions
|
@ -16,6 +16,7 @@ import Assistant.WebApp.DashBoard
|
||||||
import Assistant.WebApp.SideBar
|
import Assistant.WebApp.SideBar
|
||||||
import Assistant.WebApp.Notifications
|
import Assistant.WebApp.Notifications
|
||||||
import Assistant.WebApp.Configurators
|
import Assistant.WebApp.Configurators
|
||||||
|
import Assistant.WebApp.Documentation
|
||||||
import Assistant.ThreadedMonad
|
import Assistant.ThreadedMonad
|
||||||
import Assistant.DaemonStatus
|
import Assistant.DaemonStatus
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
|
|
|
@ -39,18 +39,40 @@ data WebApp = WebApp
|
||||||
, webAppState :: TMVar WebAppState
|
, webAppState :: TMVar WebAppState
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Yesod WebApp where
|
data NavBarItem = DashBoard | Config | About
|
||||||
defaultLayout content = do
|
deriving (Eq)
|
||||||
webapp <- getYesod
|
|
||||||
page <- widgetToPageContent $ do
|
|
||||||
addStylesheet $ StaticR css_bootstrap_css
|
|
||||||
addStylesheet $ StaticR css_bootstrap_responsive_css
|
|
||||||
addScript $ StaticR jquery_full_js
|
|
||||||
addScript $ StaticR js_bootstrap_dropdown_js
|
|
||||||
addScript $ StaticR js_bootstrap_modal_js
|
|
||||||
$(widgetFile "page")
|
|
||||||
hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap")
|
|
||||||
|
|
||||||
|
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
|
||||||
|
addStylesheet $ StaticR css_bootstrap_responsive_css
|
||||||
|
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) -}
|
{- Require an auth token be set when accessing any (non-static route) -}
|
||||||
isAuthorized _ _ = checkAuthToken secretToken
|
isAuthorized _ _ = checkAuthToken secretToken
|
||||||
|
|
||||||
|
|
|
@ -44,13 +44,12 @@ introDisplay ident = do
|
||||||
counter = map show ([1..] :: [Int])
|
counter = map show ([1..] :: [Int])
|
||||||
|
|
||||||
getConfigR :: Handler RepHtml
|
getConfigR :: Handler RepHtml
|
||||||
getConfigR = defaultLayout $ do
|
getConfigR = bootstrap (Just Config) $ do
|
||||||
sideBarDisplay
|
sideBarDisplay
|
||||||
setTitle "Configuration"
|
setTitle "Configuration"
|
||||||
[whamlet|<a href="@{HomeR}">main|]
|
$(widgetFile "configurators/main")
|
||||||
|
|
||||||
getAddRepositoryR :: Handler RepHtml
|
getAddRepositoryR :: Handler RepHtml
|
||||||
getAddRepositoryR = defaultLayout $ do
|
getAddRepositoryR = bootstrap (Just Config) $ do
|
||||||
sideBarDisplay
|
sideBarDisplay
|
||||||
setTitle "Add repository"
|
setTitle "Add repository"
|
||||||
[whamlet|<a href="@{HomeR}">main|]
|
|
||||||
|
|
|
@ -72,18 +72,17 @@ dashboard warnNoScript = do
|
||||||
$(widgetFile "dashboard/main")
|
$(widgetFile "dashboard/main")
|
||||||
|
|
||||||
getHomeR :: Handler RepHtml
|
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. -}
|
{- Same as HomeR, except with autorefreshing via meta refresh. -}
|
||||||
getNoScriptAutoR :: Handler RepHtml
|
getNoScriptAutoR :: Handler RepHtml
|
||||||
getNoScriptAutoR = defaultLayout $ do
|
getNoScriptAutoR = bootstrap (Just DashBoard) $ do
|
||||||
let ident = NoScriptR
|
let ident = NoScriptR
|
||||||
let delayseconds = 3 :: Int
|
let delayseconds = 3 :: Int
|
||||||
let this = NoScriptAutoR
|
let this = NoScriptAutoR
|
||||||
toWidgetHead $(hamletFile $ hamletTemplate "dashboard/metarefresh")
|
toWidgetHead $(hamletFile $ hamletTemplate "dashboard/metarefresh")
|
||||||
dashboard False
|
dashboard False
|
||||||
|
|
||||||
{- Same as HomeR, except no autorefresh at all (and no noscript warning). -}
|
|
||||||
getNoScriptR :: Handler RepHtml
|
|
||||||
getNoScriptR = defaultLayout $
|
|
||||||
dashboard False
|
|
||||||
|
|
22
Assistant/WebApp/Documentation.hs
Normal file
22
Assistant/WebApp/Documentation.hs
Normal file
|
@ -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")
|
|
@ -3,6 +3,7 @@
|
||||||
/noscriptauto NoScriptAutoR GET
|
/noscriptauto NoScriptAutoR GET
|
||||||
/config ConfigR GET
|
/config ConfigR GET
|
||||||
/addrepository AddRepositoryR GET
|
/addrepository AddRepositoryR GET
|
||||||
|
/about AboutR GET
|
||||||
|
|
||||||
/transfers/#NotificationId TransfersR GET
|
/transfers/#NotificationId TransfersR GET
|
||||||
/sidebar/#NotificationId SideBarR GET
|
/sidebar/#NotificationId SideBarR GET
|
||||||
|
|
|
@ -7,3 +7,4 @@ $doctype 5
|
||||||
^{pageHead page}
|
^{pageHead page}
|
||||||
<body>
|
<body>
|
||||||
^{pageBody page}
|
^{pageBody page}
|
||||||
|
<div #modal></div>
|
||||||
|
|
3
templates/configurators/main.hamlet
Normal file
3
templates/configurators/main.hamlet
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
<div .span9 .hero-unit>
|
||||||
|
<h2>
|
||||||
|
Sorry, no configuration is implemented yet...
|
16
templates/documentation/about.hamlet
Normal file
16
templates/documentation/about.hamlet
Normal file
|
@ -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
|
||||||
|
.
|
|
@ -4,10 +4,9 @@
|
||||||
<a .brand href="#">
|
<a .brand href="#">
|
||||||
git-annex
|
git-annex
|
||||||
<ul .nav>
|
<ul .nav>
|
||||||
<li .active>
|
$forall (name, route, isactive) <- navbar
|
||||||
<a href="#">Dashboard</a>
|
<li :isactive:.active>
|
||||||
<li>
|
<a href="@{route}">#{name}</a>
|
||||||
<a href="@{ConfigR}">Config</a>
|
|
||||||
<ul .nav .pull-right>
|
<ul .nav .pull-right>
|
||||||
<li .dropdown #menu1>
|
<li .dropdown #menu1>
|
||||||
<a .dropdown-toggle data-toggle="dropdown" href="#menu1">
|
<a .dropdown-toggle data-toggle="dropdown" href="#menu1">
|
||||||
|
@ -21,4 +20,3 @@
|
||||||
<div .container-fluid>
|
<div .container-fluid>
|
||||||
<div .row-fluid>
|
<div .row-fluid>
|
||||||
^{content}
|
^{content}
|
||||||
<div #modal></div>
|
|
||||||
|
|
Loading…
Reference in a new issue