siteLayout instead of pageHeadings

messages/uniworx/de.msg

@@ -231,6 +231,7 @@ HomeHeading: Aktuelle Termine
 LoginHeading: Authentifizierung
 LoginTitle: Authentifizierung
 ProfileHeading: Benutzereinstellungen
+ProfileFor: Benutzereinstellungen für
 ProfileDataHeading: Gespeicherte Benutzerdaten
 ImpressumHeading: Impressum
 SystemMessageHeading: Uni2work Statusmeldung

src/Foundation.hs

@@ -836,7 +836,7 @@ instance Yesod UniWorX where
           NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
           PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
           BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-      fmap toTypedContent . siteLayout (Just . toHtml . mr $ ErrorResponseTitle err) $ do
+      fmap toTypedContent . siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
         toWidget
           [cassius|
             .errMsg
@@ -845,7 +845,7 @@ instance Yesod UniWorX where
           |]
         errPage
 
-    defaultLayout = siteLayout Nothing
+    defaultLayout = siteLayout' Nothing
 
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
@@ -888,10 +888,21 @@ instance Yesod UniWorX where
     makeLogger = readTVarIO . snd . appLogger
 
 
+siteLayoutMsg :: (RenderMessage site msg, site ~ UniWorX) => msg -> Widget -> Handler Html
+siteLayoutMsg msg widget = do
+  mr <- getMessageRender
+  siteLayout (toWgt $ mr msg) widget
 
-siteLayout :: Maybe Html -- ^ Optionally override `pageHeading`
+siteLayoutMsg' :: (RenderMessage site msg, site ~ UniWorX) => msg -> Widget -> Handler Html
+siteLayoutMsg' = siteLayout . i18nHeading
+
+siteLayout :: Widget -- ^ `pageHeading`
            -> Widget -> Handler Html
-siteLayout headingOverride widget = do
+siteLayout = siteLayout' . Just
+
+siteLayout' :: Maybe Widget -- ^ Optionally override `pageHeading`
+           -> Widget -> Handler Html
+siteLayout' headingOverride widget = do
   master <- getYesod
   let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master
 
@@ -964,7 +975,7 @@ siteLayout headingOverride widget = do
       footer :: Widget
       footer = $(widgetFile "widgets/footer")
       contentHeadline :: Maybe Widget
-      contentHeadline = (toWidget <$> headingOverride) <|> (pageHeading =<< mcurrentRoute)
+      contentHeadline = headingOverride <|> (pageHeading =<< mcurrentRoute)
       breadcrumbsWgt :: Widget
       breadcrumbsWgt = $(widgetFile "widgets/breadcrumbs")
       pageaction :: Widget
@@ -1600,6 +1611,7 @@ pageActions _ = []
 i18nHeading :: (MonadWidget m, RenderMessage site msg, HandlerSite m ~ site) => msg -> m ()
 i18nHeading msg = liftWidgetT $ toWidget =<< getMessageRender <*> pure msg
 
+-- | only used in defaultLayout; better use siteLayout instead!
 pageHeading :: Route UniWorX -> Maybe Widget
 pageHeading (AuthR _)
   = Just $ i18nHeading MsgLoginHeading

src/Handler/Course.hs

@@ -284,7 +284,7 @@ getCShowR tid ssh csh = do
   mRegAt   <- traverse (formatTime SelFormatDateTime)   registered
   (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm (isJust mRegAt) $ courseRegisterSecret course
   registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
-  defaultLayout $ do
+  siteLayout (toWgt $ courseName course) $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
     $(widgetFile "course")
 

src/Handler/Profile.hs

@@ -87,9 +87,8 @@ postProfileR = do
 
   let formText  = Nothing :: Maybe UniWorXMessage
       actionUrl = ProfileR
-  defaultLayout $ do
+  siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
     setTitle . toHtml $ "Profil " <> userIdent
-    [whamlet| Benutzereinstellungen für ^{nameWidget userDisplayName userSurname} |]
     $(widgetFile "formPageI18n")
 
 postProfileDataR  :: Handler Html

src/Handler/Users.hs

@@ -133,14 +133,15 @@ postAdminUserR uuid = do
     let userRightsForm :: Form [(SchoolId, Bool, Bool)]
         userRightsForm csrf = do
           boxRights <- forM userRights $ \(school@(Entity sid _), E.Value isAdmin, E.Value isLecturer) ->
-            if  | Set.member sid adminSchools -> do
+            if Set.member sid adminSchools
-                    cbAdmin    <- mreq    checkBoxField "" (Just isAdmin)
+              then do
-                    cbLecturer <- mreq    checkBoxField "" (Just isLecturer)
+                cbAdmin    <- mreq    checkBoxField "" (Just isAdmin)
-                    return (school, cbAdmin, cbLecturer)
+                cbLecturer <- mreq    checkBoxField "" (Just isLecturer)
-                | otherwise -> do
+                return (school, cbAdmin, cbLecturer)
-                    cbAdmin    <- mforced checkBoxField ""       isAdmin
+              else do
-                    cbLecturer <- mforced checkBoxField ""       isLecturer
+                cbAdmin    <- mforced checkBoxField ""       isAdmin
-                    return (school, cbAdmin, cbLecturer)
+                cbLecturer <- mforced checkBoxField ""       isLecturer
+                return (school, cbAdmin, cbLecturer)
           let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) ->
                         (,,) <$> pure sid <*> resAdmin <*> resLecturer
           return (result,$(widgetFile "widgets/user-rights-form"))
@@ -160,5 +161,7 @@ postAdminUserR uuid = do
           addMessageI Info MsgAccessRightsSaved
     ((result, formWidget),formEnctype) <- runFormPost userRightsForm
     formResult result userRightsAction
-    defaultLayout
+    let heading =
+          [whamlet|_{MsgAccessRightsFor} ^{nameWidget userDisplayName userSurname}|]
+    siteLayout heading
       $(widgetFile "adminUser")

templates/adminUser.hamlet

@@ -1,6 +1,3 @@
-<h2>
-  _{MsgAccessRightsFor}
-  ^{nameWidget userDisplayName userSurname}
 <form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
   ^{formWidget}
   ^{submitButtonView}