fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

FormGroup example on profile data page implemented

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
src/Handler/Profile.hs
View File

@ -28,29 +28,59 @@ data SettingsForm = SettingsForm
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
makeSettingForm template = identForm FIDsettings $ \html -> do makeSettingForm template = identForm FIDsettings $ \html -> do
(result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2 (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
<$> aFormGroup "Cosmetics" cosmeticsForm <$ aformSection cosmeticsSection
<*> aFormGroup "Notifications" notificationsForm <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
<* submitButton (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 return (result, widget) -- no validation required here
where where
settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm cosmeticsSection :: Text
settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm cosmeticsSection = "Cosmetics"
notificationSection :: Text
notificationSection = "Notifications"
themeList = [Option (display t) t (toPathPiece t) | t <- universeF] 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) 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 :: Handler Html
getProfileR = postProfileR getProfileR = postProfileR

16
src/Handler/Utils/Form.hs
View File

@ -39,7 +39,7 @@ import Control.Monad.Writer.Class
import Data.Scientific (Scientific) import Data.Scientific (Scientific)
import Data.Ratio import Data.Ratio
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Text.Blaze (ToMarkup) import Text.Blaze (ToMarkup,preEscapedText)
import Utils.Lens import Utils.Lens
@ -640,6 +640,20 @@ infoField txt = Field { fieldEnctype = UrlEncoded
, fieldView = \_theId _name _attrs _val _isReq -> , fieldView = \_theId _name _attrs _val _isReq ->
[whamlet|#{txt}|] [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 :: Text -> Form () -- TODO: WIP, delete
infoForm infoText csrf = infoForm infoText csrf =