diff --git a/config/settings.yml b/config/settings.yml index 10c2b4545..979dd8f4e 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -209,6 +209,7 @@ user-defaults: date-time-format: "%a %d %b %Y %R" date-format: "%a %d %b %Y" time-format: "%R" + week-start: Monday download-files: false warning-days: 1209600 show-sex: false diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index b113f4f1d..d02d4e4fc 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -807,6 +807,7 @@ Date: Datum DateTimeFormat: Datums- und Uhrzeitformat DateFormat: Datumsformat TimeFormat: Uhrzeitformat +WeekStart: Erster Wochentag DownloadFiles: Dateien automatisch herunterladen DownloadFilesTip: Wenn gesetzt werden Dateien automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden). WarningDays: Fristen-Vorschau diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 096f5f519..533fbb332 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -804,6 +804,7 @@ Date: Date DateTimeFormat: Date and time format DateFormat: Date format TimeFormat: Time format +WeekStart: First day of week DownloadFiles: Automatically download files DownloadFilesTip: When set, files are automatically treated as downloads. Otherwise behaviour is browser dependent (PDFs might, for example, be opened within the browser) WarningDays: Deadline-preview diff --git a/models/users.model b/models/users.model index e6c9df554..f3deba2ac 100644 --- a/models/users.model +++ b/models/users.model @@ -28,6 +28,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user; user-defined dateFormat DateTimeFormat "default='%d.%m.%Y'" -- preferred Date-only display format for user; user-defined timeFormat DateTimeFormat "default='%R'" -- preferred Time-only display format for user; user-defined + weekStart DayOfWeek default='Monday' -- preferred first day of week for user; user-defined downloadFiles Bool default=false -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this) languages Languages Maybe -- Preferred language; user-defined notificationSettings NotificationSettings -- Bit-array for which events email notifications are requested by user; user-defined diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index cf7c67c92..3feacb28f 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -253,6 +253,7 @@ upsertCampusUser upsertMode ldapData = do , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat + , userWeekStart = userDefaultWeekStart , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userShowSex = userDefaultShowSex diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index f5605093b..6f807e312 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -44,6 +44,7 @@ data SettingsForm = SettingsForm , stgDateTime :: DateTimeFormat , stgDate :: DateTimeFormat , stgTime :: DateTimeFormat + , stgWeekStart :: DayOfWeek , stgDownloadFiles :: Bool , stgWarningDays :: NominalDiffTime , stgShowSex :: Bool @@ -114,6 +115,7 @@ makeSettingForm template html = do <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template) <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template) <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template) + <*> areq (selectField . return $ mkOptionList (weekDayList mr)) (fslI MsgWeekStart) (stgWeekStart <$> template) <* aformSection MsgFormBehaviour <*> apopt checkBoxField (fslI MsgDownloadFiles & setTooltip MsgDownloadFilesTip @@ -128,8 +130,9 @@ makeSettingForm template html = do <*> allocationNotificationForm (stgAllocationNotificationSettings <$> template) return (result, widget) -- no validation required here where - themeList = [ Option (toMessage t) t (toPathPiece t) | t <- universeF ] scheduleViewList mr = [ Option (mr t) t (toPathPiece t) | t <- universeF ] + themeList = [ Option (toMessage t) t (toPathPiece t) | t <- universeF ] + weekDayList mr = [ Option (mr t) t (toPathPiece t) | t <- universeF ] schoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandard schoolsForm' mempty @@ -367,6 +370,7 @@ postProfileR = do , stgDateTime = userDateTimeFormat , stgDate = userDateFormat , stgTime = userTimeFormat + , stgWeekStart = userWeekStart , stgDownloadFiles = userDownloadFiles , stgSchools = userSchools , stgNotificationSettings = userNotificationSettings @@ -387,6 +391,7 @@ postProfileR = do , UserDateTimeFormat =. stgDateTime , UserDateFormat =. stgDate , UserTimeFormat =. stgTime + , UserWeekStart =. stgWeekStart , UserDownloadFiles =. stgDownloadFiles , UserWarningDays =. stgWarningDays , UserNotificationSettings =. stgNotificationSettings diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index 61a259cb1..cbfa2b587 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -72,6 +72,7 @@ postAdminUserAddR = do , userDateTimeFormat = userDefaultDateTimeFormat , userDateFormat = userDefaultDateFormat , userTimeFormat = userDefaultTimeFormat + , userWeekStart = userDefaultWeekStart , userDownloadFiles = userDefaultDownloadFiles , userWarningDays = userDefaultWarningDays , userShowSex = userDefaultShowSex diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs index fd24b55e5..033a07ded 100644 --- a/src/Model/Types/Misc.hs +++ b/src/Model/Types/Misc.hs @@ -283,6 +283,9 @@ instance FromHttpApiData TokenBucketIdent where parseUrlPiece = maybe (Left "Could not parse TokenBucketIdent") Right . fromPathPiece +derivePersistField "DayOfWeek" + + pathPieceJSON ''ScheduleView pathPieceJSONKey ''ScheduleView derivePersistField "ScheduleView" diff --git a/src/Settings.hs b/src/Settings.hs index d121aef92..ae52f7921 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -209,6 +209,7 @@ data UserDefaultConf = UserDefaultConf { userDefaultTheme :: Theme , userDefaultMaxFavourites, userDefaultMaxFavouriteTerms :: Int , userDefaultDateTimeFormat, userDefaultDateFormat, userDefaultTimeFormat :: DateTimeFormat + , userDefaultWeekStart :: DayOfWeek , userDefaultDownloadFiles :: Bool , userDefaultWarningDays :: NominalDiffTime , userDefaultShowSex :: Bool diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs index 497b3c1bb..a035c3e90 100644 --- a/src/Utils/Schedule/Week.hs +++ b/src/Utils/Schedule/Week.hs @@ -28,7 +28,6 @@ weekSchedule uid scheduleOffset = do dayOffset = case scheduleOffset of ScheduleOffsetNone -> 0 ScheduleOffsetDays d -> d - -- ScheduleOffsetMonths _ -> 0 -- TODO: month offset currently not supported dayNowOffset = toInteger dayOffset `addDays` utctDay now -- TODO: single runDB for all fetches below?