Form section titles via fvId; working, but code cleanup needed.

messages/uniworx/de.msg

@@ -344,6 +344,9 @@ TimeFormat: Uhrzeitformat
 DownloadFiles: Dateien automatisch herunterladen
 DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden).
 NotificationSettings: Erwünschte Benachrichtigungen
+FormNotifications: Benachrichtigungen
+FormBehaviour: Verhalten
+FormCosmetics: Oberfläche
 
 ActiveAuthTags: Aktivierte Authorisierungsprädikate
 

src/Handler/Profile.hs

@@ -29,7 +29,7 @@ data SettingsForm = SettingsForm
 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
 makeSettingForm template = identForm FIDsettings $ \html -> do
     (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
-        <$  aformSection cosmeticsSection
+        <$  aformSection MsgFormCosmetics
         <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
             (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
         <*> areq (selectField . return $ mkOptionList themeList)
@@ -37,23 +37,15 @@ makeSettingForm template = identForm FIDsettings $ \html -> do
         <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
         <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
         <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
-        <*  aformSection behaviorSection
+        <*  aformSection MsgFormBehaviour
         <*> areq checkBoxField (fslI MsgDownloadFiles
                                    & setTooltip MsgDownloadFilesTip
                                 ) (stgDownloadFiles <$> template)
-        <*  aformSection notificationSection
+        <*  aformSection MsgFormNotifications
         <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
-    --   <$> aFormGroup "Cosmetics"     cosmeticsForm
-    --   <*> aFormGroup "Notifications" notificationsForm
         <*  submitButton
     return (result, widget) -- no validation required here
   where
-    cosmeticsSection :: Text
-    cosmeticsSection = "Cosmetics"
-    behaviorSection :: Text
-    behaviorSection = "Behavior"
-    notificationSection :: Text
-    notificationSection = "Notifications"
     themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
     nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
 --

src/Handler/Utils/Form.hs

@@ -641,18 +641,30 @@ infoField txt = Field { fieldEnctype = UrlEncoded
                       , fieldView  = \_theId _name _attrs _val _isReq ->
                            [whamlet|#{txt}|]
                       }
-aformSection :: (Monad m, ToMarkup t) => t -> AForm m ()
+aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
 aformSection = formToAForm . fmap (second pure) . formSection
 
-formSection :: (Monad m, ToMarkup t) => t -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
-formSection formSectionTitle = return (FormSuccess (), infoView)
+formSection formSectionTitle = do
+    mr <- getMessageRender
+    return (FormSuccess (), FieldView
+      { fvLabel    = toHtml $ mr formSectionTitle
+      , fvTooltip  = Nothing
+      , fvId       = "form-section-noinput"
+      , fvErrors   = Nothing
+      , fvRequired = False
+      , fvInput    = mempty
+      })
+
+formSection' :: (Monad m, ToMarkup t) => t -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection' formSectionTitle = return (FormSuccess (), infoView)
   where
     flabel :: Html
     flabel   = $(shamletFile "./templates/widgets/form-section-title.shamlet") -- TODO: Why must this be fully qualified?
     infoView = FieldView
       { fvLabel    = flabel
       , fvTooltip  = Nothing
-      , fvId       = "formSection"
+      , fvId       = "form-section-noinput"
       , fvErrors   = Nothing
       , fvRequired = False
       , fvInput    = mempty

templates/widgets/form.hamlet

@@ -3,16 +3,31 @@ $newline never
 $case formLayout
   $of FormDBTablePagesize
     $forall view <- fieldViews
-      <label .form-group__label.label-pagesize for=#{fvId view}>#{fvLabel view}
+      $if fvId view == "form-section-noinput"
-      ^{fvInput view}
+        <label .form-group__label>
+          <h3 .form-section-title>
+            ^{fvInput view}
+      $else
+        <label .form-group__label.label-pagesize for=#{fvId view}>#{fvLabel view}
+        ^{fvInput view}
   $of _
     $forall view <- fieldViews
       $# TODO: add class 'form-group--submit' if this is the submit-button view
       <div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
-        $if not (Blaze.null $ fvLabel view)
+        $if fvId view == "form-section-noinput"
-          <label .form-group__label for=#{fvId view}>
+          <label .form-group__label>
-            #{fvLabel view}
+            <h3 .form-section-title>
-            $maybe hint <- fvTooltip view
+              ^{fvLabel view}
-              <div .form-group__hint>^{hint}
+              $maybe hint <- fvTooltip view
-        <div .form-group__input>
+                  <div .form-group__hint>^{hint}
-          ^{fvInput view}
+        $else
+          $if not (Blaze.null $ fvLabel view)
+            <label .form-group__label for=#{fvId view}>
+              #{fvLabel view}
+              $maybe hint <- fvTooltip view
+                <div .form-group__hint>^{hint}
+              $# TODO: check that error display works as intended
+              $maybe err <- fvErrors view
+                <div .form-error>#{err}
+          <div .form-group__input>
+            ^{fvInput view}