improve first run screen

This commit is contained in:
Joey Hess 2012-07-31 14:23:17 -04:00
parent 0d3686972d
commit c70496dc7f
5 changed files with 46 additions and 22 deletions

View file

@ -52,25 +52,34 @@ 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)
defaultNavBar :: [NavBarItem]
defaultNavBar = [DashBoard, Config, About]
firstRunNavBar :: [NavBarItem]
firstRunNavBar = [Config, About]
selectNavBar :: Handler [NavBarItem]
selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)
inFirstRun :: Handler Bool
inFirstRun = isNothing . threadState <$> getYesod
{- 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
navbar <- map navdetails <$> selectNavBar
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")
where
navdetails i = (navBarName i, navBarRoute i, Just i == navbaritem)
instance Yesod WebApp where
{- Require an auth token be set when accessing any (non-static route) -}

View file

@ -41,14 +41,22 @@ introDisplay ident = do
where
counter = map show ([1..] :: [Int])
addRepository :: Bool -> Widget
addRepository firstrun = do
setTitle $ if firstrun then "Getting started" else "Add repository"
$(widgetFile "configurators/addrepository")
getConfigR :: Handler RepHtml
getConfigR = bootstrap (Just Config) $ do
sideBarDisplay
setTitle "Configuration"
$(widgetFile "configurators/main")
ifM (lift inFirstRun)
( addRepository True
, do
setTitle "Configuration"
$(widgetFile "configurators/main")
)
getAddRepositoryR :: Handler RepHtml
getAddRepositoryR = bootstrap (Just Config) $ do
sideBarDisplay
setTitle "Add repository"
$(widgetFile "configurators/addrepository")
addRepository False

View file

@ -71,11 +71,14 @@ dashboard warnNoScript = do
$(widgetFile "dashboard/main")
getHomeR :: Handler RepHtml
getHomeR = bootstrap (Just DashBoard) $ dashboard True
getHomeR = ifM (inFirstRun)
( redirect ConfigR
, 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
getNoScriptR = bootstrap (Just DashBoard) $ dashboard False
{- Same as HomeR, except with autorefreshing via meta refresh. -}
getNoScriptAutoR :: Handler RepHtml