forked from filipg/gonito
Enable some layout customization
This commit is contained in:
parent
80b5ae6b33
commit
d5aadec1de
1
.gitignore
vendored
1
.gitignore
vendored
@ -21,3 +21,4 @@ cabal.sandbox.config
|
|||||||
arena/t*
|
arena/t*
|
||||||
arena/r*
|
arena/r*
|
||||||
gonito-*.tar.gz
|
gonito-*.tar.gz
|
||||||
|
stack.yaml.lock
|
||||||
|
@ -8,10 +8,13 @@ import Text.Hamlet (hamletFile)
|
|||||||
import Yesod.Auth.HashDB (HashDBUser(..), authHashDBWithForm)
|
import Yesod.Auth.HashDB (HashDBUser(..), authHashDBWithForm)
|
||||||
import qualified Yesod.Core.Unsafe as Unsafe
|
import qualified Yesod.Core.Unsafe as Unsafe
|
||||||
import Yesod.Core.Types (Logger)
|
import Yesod.Core.Types (Logger)
|
||||||
import qualified Data.CaseInsensitive as CI
|
|
||||||
import qualified Data.Text.Encoding as TE
|
|
||||||
import Yesod.Default.Util (addStaticContentExternal)
|
import Yesod.Default.Util (addStaticContentExternal)
|
||||||
|
|
||||||
|
import Text.Blaze
|
||||||
|
import Text.Blaze.Internal (MarkupM)
|
||||||
|
|
||||||
|
import Data.Default
|
||||||
|
|
||||||
instance HashDBUser User where
|
instance HashDBUser User where
|
||||||
userPasswordHash = userPassword
|
userPasswordHash = userPassword
|
||||||
setPasswordHash h u = u { userPassword = Just h }
|
setPasswordHash h u = u { userPassword = Just h }
|
||||||
@ -83,6 +86,41 @@ isTrusted user =
|
|||||||
"rafalj@amu.edu.pl" -> True
|
"rafalj@amu.edu.pl" -> True
|
||||||
_ -> True
|
_ -> True
|
||||||
|
|
||||||
|
data LayoutCustomization = LayoutCustomization {
|
||||||
|
layoutCustomizationBanner :: Maybe Text,
|
||||||
|
layoutCustomizationRightPanel :: Maybe (WidgetFor App ())
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Default LayoutCustomization where
|
||||||
|
def = LayoutCustomization {
|
||||||
|
layoutCustomizationBanner = Nothing,
|
||||||
|
layoutCustomizationRightPanel = Nothing }
|
||||||
|
|
||||||
|
ourBanner :: Text -> LayoutCustomization
|
||||||
|
ourBanner banner = def {
|
||||||
|
layoutCustomizationBanner = Just ("/static/images/" <> banner <> ".jpg")
|
||||||
|
}
|
||||||
|
|
||||||
|
defaultCustomizableLayout :: ToWidget App a => LayoutCustomization -> a -> HandlerFor App (MarkupM ())
|
||||||
|
defaultCustomizableLayout customization widget = do
|
||||||
|
let mBanner = layoutCustomizationBanner customization
|
||||||
|
let mRightPanel = layoutCustomizationRightPanel customization
|
||||||
|
|
||||||
|
master <- getYesod
|
||||||
|
mmsg <- getMessage
|
||||||
|
|
||||||
|
-- We break up the default layout into two components:
|
||||||
|
-- default-layout is the contents of the body tag, and
|
||||||
|
-- default-layout-wrapper is the entire page. Since the final
|
||||||
|
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
||||||
|
-- you to use normal widget features in default-layout.
|
||||||
|
|
||||||
|
maybeUser <- maybeAuth
|
||||||
|
|
||||||
|
pc <- widgetToPageContent $ do
|
||||||
|
$(widgetFile "default-layout")
|
||||||
|
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||||
|
|
||||||
|
|
||||||
-- Please see the documentation for the Yesod typeclass. There are a number
|
-- Please see the documentation for the Yesod typeclass. There are a number
|
||||||
-- of settings which can be configured by overriding methods here.
|
-- of settings which can be configured by overriding methods here.
|
||||||
@ -107,21 +145,7 @@ instance Yesod App where
|
|||||||
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
|
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
|
||||||
yesodMiddleware = defaultYesodMiddleware
|
yesodMiddleware = defaultYesodMiddleware
|
||||||
|
|
||||||
defaultLayout widget = do
|
defaultLayout widget = defaultCustomizableLayout def widget
|
||||||
master <- getYesod
|
|
||||||
mmsg <- getMessage
|
|
||||||
|
|
||||||
-- We break up the default layout into two components:
|
|
||||||
-- default-layout is the contents of the body tag, and
|
|
||||||
-- default-layout-wrapper is the entire page. Since the final
|
|
||||||
-- value passed to hamletToRepHtml cannot be a widget, this allows
|
|
||||||
-- you to use normal widget features in default-layout.
|
|
||||||
|
|
||||||
maybeUser <- maybeAuth
|
|
||||||
|
|
||||||
pc <- widgetToPageContent $ do
|
|
||||||
$(widgetFile "default-layout")
|
|
||||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
|
||||||
|
|
||||||
-- The page to be redirected to when authentication is required.
|
-- The page to be redirected to when authentication is required.
|
||||||
authRoute _ = Just $ AuthR LoginR
|
authRoute _ = Just $ AuthR LoginR
|
||||||
|
Loading…
Reference in New Issue
Block a user