diff options
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Threads/WebApp.hs | 1 | ||||
-rw-r--r-- | Assistant/WebApp.hs | 44 | ||||
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 7 | ||||
-rw-r--r-- | Assistant/WebApp/DashBoard.hs | 13 | ||||
-rw-r--r-- | Assistant/WebApp/Documentation.hs | 22 | ||||
-rw-r--r-- | Assistant/WebApp/routes | 1 |
6 files changed, 66 insertions, 22 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 7b794b6eb..ca81498f4 100644 --- a/Assistant/Threads/WebApp.hs +++ b/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 diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs index d3989a68a..fc40ca5bf 100644 --- a/Assistant/WebApp.hs +++ b/Assistant/WebApp.hs @@ -39,18 +39,40 @@ data WebApp = WebApp , webAppState :: TMVar WebAppState } -instance Yesod WebApp where - defaultLayout 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 - $(widgetFile "page") - hamletToRepHtml $(hamletFile $ hamletTemplate "bootstrap") +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 + 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) -} isAuthorized _ _ = checkAuthToken secretToken diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index e3f0275d9..47a9b687e 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/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|] diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 2961dabd3..f80fb8787 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/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 diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs new file mode 100644 index 000000000..b0a9e4d98 --- /dev/null +++ b/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") diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 75f1ad7c7..5a1550b24 100644 --- a/Assistant/WebApp/routes +++ b/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 |