FormGroup example on profile data page implemented

This commit is contained in:
SJost 2019-02-16 16:17:33 +01:00
parent 1cc9ca119f
commit 9287d89e33
2 changed files with 64 additions and 20 deletions

View File

@ -28,29 +28,59 @@ data SettingsForm = SettingsForm
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
makeSettingForm template = identForm FIDsettings $ \html -> do
(result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
<$> aFormGroup "Cosmetics" cosmeticsForm
<*> aFormGroup "Notifications" notificationsForm
<* submitButton
(result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
<$ aformSection cosmeticsSection
<*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
(fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
<*> areq (selectField . return $ mkOptionList themeList)
(fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
<*> 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 notificationSection
<*> areq checkBoxField (fslI MsgDownloadFiles
& setTooltip MsgDownloadFilesTip
) (stgDownloadFiles <$> template)
<*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
-- <$> aFormGroup "Cosmetics" cosmeticsForm
-- <*> aFormGroup "Notifications" notificationsForm
<* submitButton
return (result, widget) -- no validation required here
where
settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
cosmeticsSection :: Text
cosmeticsSection = "Cosmetics"
notificationSection :: Text
notificationSection = "Notifications"
themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
cosmeticsForm = (,,,,)
<$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
(fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
<*> areq (selectField . return $ mkOptionList themeList)
(fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
<*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
<*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
notificationsForm = (,)
<$> areq checkBoxField (fslI MsgDownloadFiles
& setTooltip MsgDownloadFilesTip
) (stgDownloadFiles <$> template)
<*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
--
-- Version with proper grouping:
--
-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
-- makeSettingForm template = identForm FIDsettings $ \html -> do
-- (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
-- <$> aFormGroup "Cosmetics" cosmeticsForm
-- <*> aFormGroup "Notifications" notificationsForm
-- <* submitButton
-- return (result, widget) -- no validation required here
-- where
-- settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
-- settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
-- themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
-- cosmeticsForm = (,,,,)
-- <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
-- (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
-- <*> areq (selectField . return $ mkOptionList themeList)
-- (fslI MsgTheme) { fsId = Just "theme-select" } (stgTheme <$> template)
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
-- <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
-- notificationsForm = (,)
-- <$> areq checkBoxField (fslI MsgDownloadFiles
-- & setTooltip MsgDownloadFilesTip
-- ) (stgDownloadFiles <$> template)
-- <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
-- nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
getProfileR, postProfileR :: Handler Html
getProfileR = postProfileR

View File

@ -39,7 +39,7 @@ import Control.Monad.Writer.Class
import Data.Scientific (Scientific)
import Data.Ratio
import Text.Read (readMaybe)
import Text.Blaze (ToMarkup)
import Text.Blaze (ToMarkup,preEscapedText)
import Utils.Lens
@ -640,6 +640,20 @@ infoField txt = Field { fieldEnctype = UrlEncoded
, fieldView = \_theId _name _attrs _val _isReq ->
[whamlet|#{txt}|]
}
aformSection :: (Monad m) => Text -> AForm m ()
aformSection = formToAForm . formSection
formSection :: (Monad m) => Text -> MForm m (FormResult (), [FieldView site]) -- TODO: WIP, delete
formSection infoText = return (FormSuccess (), [infoView])
where
infoView = FieldView
{ fvLabel = preEscapedText $ "<h3 class=form-group-title>" <> infoText <> "</h3>"
, fvTooltip = Nothing
, fvId = "formSection"
, fvErrors = Nothing
, fvRequired = False
, fvInput = mempty -- [whamlet|<h3 .form-group-title>#{infoText}|]
}
infoForm :: Text -> Form () -- TODO: WIP, delete
infoForm infoText csrf =