diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index e5886e839..ee6ddab04 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -17,6 +17,26 @@ import Handler.Utils import qualified Database.Esqueleto as E import Database.Esqueleto ((^.)) + + +data SettingsForm = SettingsForm + { stgMaxFavourties :: Int + , stgTheme :: Theme + } + +makeSettingForm :: Maybe SettingsForm -> Form SettingsForm +makeSettingForm template = identForm FIDsettings $ \html -> do + let themeList = [(display t,t) | t <- allThemes] + flip (renderAForm FormStandard) html $ SettingsForm + <$> areq (natField "Favoriten") -- TODO: natFieldI not working here + (fslpI MsgFavoriten "12") (stgMaxFavourties <$> template) + <*> areq (selectFieldList themeList) + (fslI MsgTheme ) (stgTheme <$> template) + <* submitButton + -- no validation required here + + + getProfileR :: Handler Html getProfileR = do (uid, User{..}) <- requireAuthPair diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index eee978301..63d5c4bd2 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -48,7 +48,7 @@ import Control.Monad.Writer.Class -- Unique Form Identifiers to avoid accidents -- ------------------------------------------------ -data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission +data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings deriving (Enum, Eq, Ord, Bounded, Read, Show) @@ -226,6 +226,10 @@ buttonForm csrf = do -- Fields -- ------------ + +natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => FormMessage -> Field m i +natFieldI msg = checkBool (>= 0) msg intField + natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i natField d = checkBool (>= 0) (T.append d " muss eine natürliche Zahl sein.") $ intField @@ -393,6 +397,15 @@ fsl lbl = , fsAttrs = [] } +fslI :: RenderMessage UniWorX msg => msg -> FieldSettings UniWorX +fslI lbl = + FieldSettings { fsLabel = (SomeMessage lbl) + , fsTooltip = Nothing + , fsId = Nothing + , fsName = Nothing + , fsAttrs = [] + } + fslp :: Text -> Text -> FieldSettings UniWorX fslp lbl placeholder = FieldSettings { fsLabel = (SomeMessage lbl) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index bab4a2439..97b5689e1 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -209,7 +209,7 @@ derivePersistField "StudyFieldType" data Theme --Simply add Themes to this type only. CamelCase will be converted to "-lower" = Default | NeutralBlue - | AberdeenReds + | AberdeenRedso | MintGreen | SkyLove deriving (Eq,Ord,Bounded,Enum)