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

Themes and Favorites work now, but need reload or page change.

Browse Source
This commit is contained in:
SJost 2018-06-26 14:00:41 +02:00
parent 097e0c45e7
commit 2525ad553f
2 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Handler/Profile.hs
View File

@ -27,13 +27,13 @@ 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
let themeList = [(display t,t) | t <- allThemes] let themeList = [(display t,t) | t <- allThemes]
flip (renderAForm FormStandard) html $ SettingsForm (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
<$> areq (natField "Favoriten") -- TODO: natFieldI not working here <$> areq (natField "Favoriten") -- TODO: natFieldI not working here
(fslpI MsgFavoriten "12") (stgMaxFavourties <$> template) (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
<*> areq (selectFieldList themeList) <*> areq (selectFieldList themeList)
(fslI MsgTheme ) (stgTheme <$> template) (fslI MsgTheme ) (stgTheme <$> template)
<* submitButton <* submitButton
-- no validation required here return (result, widget) -- no validation required here
@ -47,10 +47,9 @@ getProfileR = do
((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate ((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate
case res of case res of
(FormSuccess SettingsForm{..}) -> do (FormSuccess SettingsForm{..}) -> do
runDB $ update uid [ UserMaxFavourites =. userMaxFavourites runDB $ update uid [ UserMaxFavourites =. stgMaxFavourties
, UserTheme =. userTheme , UserTheme =. stgTheme
] ]
addMessage "info" $ toHtml $ "LOG:" ++ display userMaxFavourites ++ display userTheme
addMessageI "info" $ MsgSettingsUpdate addMessageI "info" $ MsgSettingsUpdate
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
_ -> return () _ -> return ()

2
src/Model/Types.hs
View File

@ -209,7 +209,7 @@ derivePersistField "StudyFieldType"
data Theme --Simply add Themes to this type only. CamelCase will be converted to "-lower" data Theme --Simply add Themes to this type only. CamelCase will be converted to "-lower"
= Default = Default
| NeutralBlue | NeutralBlue
| AberdeenRedso | AberdeenReds
| MintGreen | MintGreen
| SkyLove | SkyLove
deriving (Eq,Ord,Bounded,Enum) deriving (Eq,Ord,Bounded,Enum)