FormGroup example on profile data page implemented
This commit is contained in:
parent
1cc9ca119f
commit
9287d89e33
@ -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
|
||||
|
||||
@ -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 =
|
||||
|
||||
Loading…
Reference in New Issue
Block a user