From d5aadec1dead32bffe4d108cd90b82386bdd8e12 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 5 Oct 2019 14:04:24 +0200
Subject: [PATCH] Enable some layout customization

---
 .gitignore    |  1 +
 Foundation.hs | 58 ++++++++++++++++++++++++++++++++++++---------------
 2 files changed, 42 insertions(+), 17 deletions(-)

diff --git a/.gitignore b/.gitignore
index 538c4f8..724a2d8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ cabal.sandbox.config
 arena/t*
 arena/r*
 gonito-*.tar.gz
+stack.yaml.lock
diff --git a/Foundation.hs b/Foundation.hs
index a129f3a..d284515 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -8,10 +8,13 @@ import Text.Hamlet                 (hamletFile)
 import Yesod.Auth.HashDB           (HashDBUser(..), authHashDBWithForm)
 import qualified Yesod.Core.Unsafe as Unsafe
 import Yesod.Core.Types            (Logger)
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Text.Encoding as TE
 import Yesod.Default.Util          (addStaticContentExternal)
 
+import Text.Blaze
+import Text.Blaze.Internal (MarkupM)
+
+import Data.Default
+
 instance HashDBUser User where
     userPasswordHash = userPassword
     setPasswordHash h u = u { userPassword = Just h }
@@ -83,6 +86,41 @@ isTrusted user =
     "rafalj@amu.edu.pl" -> 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
 -- 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 = defaultYesodMiddleware
 
-    defaultLayout widget = do
-        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")
+    defaultLayout widget = defaultCustomizableLayout def widget
 
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR