Enable some layout customization

This commit is contained in:
Filip Gralinski 2019-10-05 14:04:24 +02:00
parent 80b5ae6b33
commit d5aadec1de
2 changed files with 42 additions and 17 deletions

1
.gitignore vendored
View File

@ -21,3 +21,4 @@ cabal.sandbox.config
arena/t* arena/t*
arena/r* arena/r*
gonito-*.tar.gz gonito-*.tar.gz
stack.yaml.lock

View File

@ -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