gratuitous rename HomeR -> DashboardR
This commit is contained in:
parent
aa19dd263a
commit
0ef8d806ac
9 changed files with 18 additions and 17 deletions
|
@ -88,6 +88,6 @@ webAppThread assistantdata urlrenderer noannex postfirstrun onstartup = thread $
|
|||
maybe noop (\a -> a url htmlshim) onstartup
|
||||
|
||||
myUrl :: WebApp -> SockAddr -> Url
|
||||
myUrl webapp addr = unpack $ yesodRender webapp urlbase HomeR []
|
||||
myUrl webapp addr = unpack $ yesodRender webapp urlbase DashboardR []
|
||||
where
|
||||
urlbase = pack $ "http://" ++ show addr
|
||||
|
|
|
@ -93,12 +93,12 @@ renderUrl urlrenderer route params = do
|
|||
r <- readMVar urlrenderer
|
||||
return $ r route params
|
||||
|
||||
{- Redirects back to the referring page, or if there's none, HomeR -}
|
||||
{- Redirects back to the referring page, or if there's none, DashboardR -}
|
||||
redirectBack :: Handler ()
|
||||
redirectBack = do
|
||||
clearUltDest
|
||||
setUltDestReferer
|
||||
redirectUltDest HomeR
|
||||
redirectUltDest DashboardR
|
||||
|
||||
controlMenu :: Widget
|
||||
controlMenu = $(widgetFile "controlmenu")
|
||||
|
|
|
@ -205,7 +205,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do
|
|||
{- Sends pairing messages until the thread is killed,
|
||||
- and shows an activity alert while doing it.
|
||||
-
|
||||
- The cancel button returns the user to the HomeR. This is
|
||||
- The cancel button returns the user to the DashboardR. This is
|
||||
- not ideal, but they have to be sent somewhere, and could
|
||||
- have been on a page specific to the in-process pairing
|
||||
- that just stopped, so can't go back there.
|
||||
|
@ -214,7 +214,7 @@ startLocalPairing stage oncancel alert muuid displaysecret secret = do
|
|||
tid <- liftIO myThreadId
|
||||
let selfdestruct = AlertButton
|
||||
{ buttonLabel = "Cancel"
|
||||
, buttonUrl = urlrender HomeR
|
||||
, buttonUrl = urlrender DashboardR
|
||||
, buttonAction = Just $ const $ do
|
||||
oncancel
|
||||
killThread tid
|
||||
|
|
|
@ -62,7 +62,7 @@ simplifyTransfers (v@(t1, _):r@((t2, _):l))
|
|||
-
|
||||
- Note that the head of the widget is not included, only its
|
||||
- body is. To get the widget head content, the widget is also
|
||||
- inserted onto the getHomeR page.
|
||||
- inserted onto the getDashboardR page.
|
||||
-}
|
||||
getTransfersR :: NotificationId -> Handler RepHtml
|
||||
getTransfersR nid = do
|
||||
|
@ -77,21 +77,21 @@ dashboard warnNoScript = do
|
|||
let content = transfersDisplay warnNoScript
|
||||
$(widgetFile "dashboard/main")
|
||||
|
||||
getHomeR :: Handler RepHtml
|
||||
getHomeR = ifM (inFirstRun)
|
||||
getDashboardR :: Handler RepHtml
|
||||
getDashboardR = ifM (inFirstRun)
|
||||
( redirect ConfigurationR
|
||||
, page "" (Just DashBoard) $ dashboard True
|
||||
)
|
||||
|
||||
{- Used to test if the webapp is running. -}
|
||||
headHomeR :: Handler ()
|
||||
headHomeR = noop
|
||||
headDashboardR :: Handler ()
|
||||
headDashboardR = noop
|
||||
|
||||
{- Same as HomeR, except no autorefresh at all (and no noscript warning). -}
|
||||
{- Same as DashboardR, except no autorefresh at all (and no noscript warning). -}
|
||||
getNoScriptR :: Handler RepHtml
|
||||
getNoScriptR = page "" (Just DashBoard) $ dashboard False
|
||||
|
||||
{- Same as HomeR, except with autorefreshing via meta refresh. -}
|
||||
{- Same as DashboardR, except with autorefreshing via meta refresh. -}
|
||||
getNoScriptAutoR :: Handler RepHtml
|
||||
getNoScriptAutoR = page "" (Just DashBoard) $ do
|
||||
let ident = NoScriptR
|
||||
|
|
|
@ -29,7 +29,7 @@ navBarName Configuration = "Configuration"
|
|||
navBarName About = "About"
|
||||
|
||||
navBarRoute :: NavBarItem -> Route WebApp
|
||||
navBarRoute DashBoard = HomeR
|
||||
navBarRoute DashBoard = DashboardR
|
||||
navBarRoute Repositories = RepositoriesR
|
||||
navBarRoute Configuration = ConfigurationR
|
||||
navBarRoute About = AboutR
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
||||
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Assistant.WebApp.Types where
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/ HomeR GET HEAD
|
||||
/ DashboardR GET HEAD
|
||||
/repositories RepositoriesR GET
|
||||
|
||||
/noscript NoScriptR GET
|
||||
|
|
|
@ -7,5 +7,5 @@
|
|||
<p>
|
||||
<a .btn .btn-primary .btn-large href="@{FinishXMPPPairR pairkey}">
|
||||
Accept pair request
|
||||
<a .btn .btn-large href="@{HomeR}">
|
||||
<a .btn .btn-large href="@{DashboardR}">
|
||||
No thanks
|
||||
|
|
|
@ -4,5 +4,5 @@
|
|||
<p>
|
||||
<a .btn .btn-danger href="@{ShutdownConfirmedR}">
|
||||
<i .icon-off></i> Confirm shutdown
|
||||
<a .btn href="@{HomeR}">
|
||||
<a .btn href="@{DashboardR}">
|
||||
Keep running
|
||||
|
|
Loading…
Reference in a new issue