{- git-annex assistant webapp page display - - Copyright 2012 Joey Hess - - 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 qualified Text.Hamlet as Hamlet import Data.Text (Text) data NavBarItem = DashBoard | Configuration | About deriving (Eq, Ord, Enum, Bounded) navBarName :: NavBarItem -> Text navBarName DashBoard = "Dashboard" navBarName Configuration = "Configuration" navBarName About = "About" navBarRoute :: NavBarItem -> Route WebApp navBarRoute DashBoard = DashboardR navBarRoute Configuration = ConfigurationR navBarRoute About = AboutR defaultNavBar :: [NavBarItem] defaultNavBar = [minBound .. maxBound] firstRunNavBar :: [NavBarItem] firstRunNavBar = [Configuration, 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 :: Hamlet.Html -> Maybe NavBarItem -> Widget -> Handler Html 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 Html 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 addScript $ StaticR js_bootstrap_collapse_js $(widgetFile "page") giveUrlRenderer $(Hamlet.hamletFile $ hamletTemplate "bootstrap") where navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem) controlMenu :: Widget controlMenu = $(widgetFile "controlmenu")