refactor
This commit is contained in:
parent
3bd354ab84
commit
59733456ed
15 changed files with 129 additions and 172 deletions
66
Assistant/WebApp/Page.hs
Normal file
66
Assistant/WebApp/Page.hs
Normal file
|
@ -0,0 +1,66 @@
|
|||
{- git-annex assistant webapp page display
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
||||
|
||||
module Assistant.WebApp.Page where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Utility.Yesod
|
||||
|
||||
import Yesod
|
||||
import Text.Hamlet
|
||||
import Data.Text (Text)
|
||||
|
||||
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
|
||||
|
||||
defaultNavBar :: [NavBarItem]
|
||||
defaultNavBar = [DashBoard, Config, About]
|
||||
|
||||
firstRunNavBar :: [NavBarItem]
|
||||
firstRunNavBar = [Config, About]
|
||||
|
||||
selectNavBar :: Handler [NavBarItem]
|
||||
selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)
|
||||
|
||||
{- A standard page of the webapp, with a title, a sidebar, and that may
|
||||
- be highlighted on the navbar. -}
|
||||
page :: Html -> Maybe NavBarItem -> Widget -> Handler RepHtml
|
||||
page title navbaritem content = customPage navbaritem $ do
|
||||
setTitle title
|
||||
sideBarDisplay
|
||||
content
|
||||
|
||||
{- A custom page, with no title or sidebar set. -}
|
||||
customPage :: Maybe NavBarItem -> Widget -> Handler RepHtml
|
||||
customPage navbaritem content = do
|
||||
webapp <- getYesod
|
||||
navbar <- map navdetails <$> selectNavBar
|
||||
pageinfo <- 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")
|
||||
where
|
||||
navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
|
Loading…
Add table
Add a link
Reference in a new issue