diff --git a/config/settings.yml b/config/settings.yml index eed1151e7..1ff6659ab 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -214,9 +214,10 @@ user-defaults: warning-days: 1209600 show-sex: false schedule-view: view-week - schedule-week-time-from: 8 - schedule-week-time-to: 18 - schedule-week-timeslot-length: 2 + schedule-week-days: [Monday,Tuesday,Wednesday,Thursday,Friday] + schedule-week-time-from: 8 + schedule-week-time-to: 18 + schedule-week-timeslot-length: 2 schedule-occurrence-display-default: true # During central allocations lecturer-given ratings of applications (as diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 3cfe8f0b8..53d55bc25 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -109,6 +109,8 @@ ScheduleViewWeek: Woche ProfileScheduleView: Standard-Ansicht ProfileScheduleViewTip: Betrifft die Terminübersicht auf „Aktuelles“ und „Terminübersicht“. (Weitere Ansichten sind in Arbeit.) +ScheduleWeekDays: In der Wochenansicht dargestellte Wochentage +ScheduleWeekDaysTip: Wochentage, welche standardmäßig in der Wochenansicht dargestellt werden. Gibt es einen darzustellenden Termin, der auf einen Wochentag fällt welcher hier nicht gesetzt ist, so wird der jeweilige Wochentag als zusätzliche Spalte angezeigt. ScheduleWeekTimeFrom: Beginn (Stunde) des ersten in der Wochenansicht dargestellten Zeitslots ScheduleWeekTimeFromTip: Stunde, zu welcher der erste in der Wochenansicht dargestellte Zeitslot beginnt. Gibt es einen darzustellenden Termin, der in einem Zeitslot vor dem hier angegebenen Zeitslot liegt, so wird der jeweilige Zeitslot als zusätzliche Zeile vor dem hier angegeben Zeitslot angezeigt. ScheduleWeekTimeFromPlaceholder: Erster Zeitslot diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 36c96949f..0aac8123f 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -110,6 +110,8 @@ ScheduleViewWeek: Week ProfileScheduleView: Standard view ProfileScheduleViewTip: Relevant for the schedule on "News" and "Schedule". (More views are in the works.) +ScheduleWeekDays: Weekdays to display in the weekly schedule +ScheduleWeekDaysTip: Weekdays to display by default in the weekly schedule. If there is an occurrence to display which occurs on a weekday that is not set here, the weekday will be displayed as a separate column regardless. ScheduleWeekTimeFrom: Start (hour) of the first timeslot to display in the weekly schedule ScheduleWeekTimeFromTip: The hour at which the first timeslot to display in the weekly schedule begins. If there is an occurrence to display which lies in a timeslot before the one given here, the respective timeslot will be displayed above this one as a separate row. ScheduleWeekTimeFromPlaceholder: First timeslot diff --git a/models/users.model b/models/users.model index 70405a783..896262865 100644 --- a/models/users.model +++ b/models/users.model @@ -37,6 +37,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create sex Sex Maybe showSex Bool default=false scheduleView ScheduleView default='ScheduleViewWeek' + scheduleWeekDays ScheduleWeekDays default='["monday","tuesday","wednesday","thursday","friday"]'::jsonb -- which weekdays to display by default; if there is an occurrence to display for a weekday that is not mentioned here, the weekday will be displayed regardless scheduleWeekTimeFrom Int default=8 -- starting hour of the first time slot to display in weekly schedule by default (i.e. regardless of the existence of occurrences in this slot); TODO: increase precision to minutes scheduleWeekTimeTo Int default=18 -- starting hour of the last time slot to display in weekly schedule by default (i.e. regardless of the existence of occurrences in this slot); TODO: increase precision to minutes; TODO: save last hour/minute to display instead of first (of last time slot) scheduleWeekTimeslotLength Int default=2 -- length of one timeslot in hours; TODO: increase precision to minutes diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index d5c45f106..e1b515e98 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -258,6 +258,7 @@ upsertCampusUser upsertMode ldapData = do , userWarningDays = userDefaultWarningDays , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 82bf549dc..e2ff11b91 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -38,6 +38,7 @@ data SettingsForm = SettingsForm { stgDisplayName :: UserDisplayName , stgDisplayEmail :: UserEmail , stgScheduleView :: ScheduleView + , stgScheduleWeekDays :: ScheduleWeekDays , stgScheduleWeekTimeFrom :: Int , stgScheduleWeekTimeTo :: Int , stgScheduleWeekTimeslotLength :: Int @@ -109,6 +110,7 @@ makeSettingForm template html = do <* aformSection MsgSchedule <*> areq (selectField . return $ mkOptionList (scheduleViewList mr)) (fslI MsgProfileScheduleView & setTooltip MsgProfileScheduleViewTip) { fsId = Just "schedule-view-select" } (stgScheduleView <$> template) + <*> scheduleWeekDaysForm (stgScheduleWeekDays <$> template) <*> areq (natFieldI MsgScheduleWeekTimeFrom) (fslpI MsgScheduleWeekTimeFrom (mr MsgScheduleWeekTimeFromPlaceholder) & setTooltip MsgScheduleWeekTimeFromTip) (stgScheduleWeekTimeFrom <$> template) <*> areq (natFieldI MsgScheduleWeekTimeTo ) @@ -145,6 +147,28 @@ makeSettingForm template html = do themeList = [ Option (toMessage t) t (toPathPiece t) | t <- universeF ] weekDayList mr = [ Option (mr t) t (toPathPiece t) | t <- universeF ] +scheduleWeekDaysForm :: Maybe ScheduleWeekDays -> AForm Handler ScheduleWeekDays +scheduleWeekDaysForm template = formToAForm $ scheduleWeekDaysView =<< renderWForm FormStandard scheduleWeekDaysForm' mempty + where + scheduleWeekDaysForm' :: WForm Handler (FormResult ScheduleWeekDays) + scheduleWeekDaysForm' = do + mr <- getMessageRender + let allWeekDays = universeF + weekDayForm wDay = fmap (ScheduleWeekDays . bool mempty [wDay]) <$> wpopt checkBoxField (fslI $ mr wDay) ((\(ScheduleWeekDays wDays) -> wDay `elem` wDays) <$> template) + fold <$> mapM weekDayForm allWeekDays + + scheduleWeekDaysView :: (FormResult ScheduleWeekDays, Widget) -> MForm Handler (FormResult ScheduleWeekDays, [FieldView UniWorX]) + scheduleWeekDaysView (res, fvInput) = do + mr <- getMessageRender + let fvLabel = toHtml $ mr MsgScheduleWeekDays + fvTooltip = Just . toHtml $ mr MsgScheduleWeekDaysTip + fvRequired = False + fvErrors + | FormFailure (err : _) <- res = Just $ toHtml err + | otherwise = Nothing + fvId <- newIdent + return (res, pure FieldView{..}) + schoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId) schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandard schoolsForm' mempty where @@ -391,6 +415,7 @@ postProfileR = do { stgDisplayName = userDisplayName , stgDisplayEmail = userDisplayEmail , stgScheduleView = userScheduleView + , stgScheduleWeekDays = userScheduleWeekDays , stgScheduleWeekTimeFrom = userScheduleWeekTimeFrom , stgScheduleWeekTimeTo = userScheduleWeekTimeTo , stgScheduleWeekTimeslotLength = userScheduleWeekTimeslotLength @@ -416,6 +441,7 @@ postProfileR = do update uid $ [ UserDisplayName =. stgDisplayName , UserScheduleView =. stgScheduleView + , UserScheduleWeekDays =. stgScheduleWeekDays , UserScheduleWeekTimeFrom =. stgScheduleWeekTimeFrom , UserScheduleWeekTimeTo =. stgScheduleWeekTimeTo , UserScheduleWeekTimeslotLength =. stgScheduleWeekTimeslotLength diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index df28be187..e1e049155 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -77,6 +77,7 @@ postAdminUserAddR = do , userWarningDays = userDefaultWarningDays , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength diff --git a/src/Model/Types/Misc.hs b/src/Model/Types/Misc.hs index 033a07ded..92db27b6a 100644 --- a/src/Model/Types/Misc.hs +++ b/src/Model/Types/Misc.hs @@ -285,6 +285,17 @@ instance FromHttpApiData TokenBucketIdent where derivePersistField "DayOfWeek" +newtype ScheduleWeekDays = ScheduleWeekDays [DayOfWeek] + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +instance Semigroup ScheduleWeekDays where + ScheduleWeekDays w <> ScheduleWeekDays w' = ScheduleWeekDays $ w <> w' +instance Monoid ScheduleWeekDays where + mempty = ScheduleWeekDays mempty + +deriveJSON defaultOptions ''ScheduleWeekDays +derivePersistFieldJSON ''ScheduleWeekDays + pathPieceJSON ''ScheduleView pathPieceJSONKey ''ScheduleView diff --git a/src/Settings.hs b/src/Settings.hs index e331535cb..422a65b70 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -214,6 +214,7 @@ data UserDefaultConf = UserDefaultConf , userDefaultWarningDays :: NominalDiffTime , userDefaultShowSex :: Bool , userDefaultScheduleView :: ScheduleView + , userDefaultScheduleWeekDays :: ScheduleWeekDays , userDefaultScheduleWeekTimeFrom, userDefaultScheduleWeekTimeTo :: Int , userDefaultScheduleWeekTimeslotLength :: Int , userDefaultScheduleOccurrenceDisplayDefault :: Bool diff --git a/src/Utils/Schedule/Week/Types.hs b/src/Utils/Schedule/Week/Types.hs new file mode 100644 index 000000000..a4225dded --- /dev/null +++ b/src/Utils/Schedule/Week/Types.hs @@ -0,0 +1,5 @@ +module Utils.Schedule.Week.Types + ( module Utils.Schedule.Week.Types + ) where + +import Utils.Schedule.Week.Types.TimeSlot as Utils.Schedule.Week.Types diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 4e46553be..f3c9e0582 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -125,6 +125,7 @@ fillDb = do , userSex = Just SexMale , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -160,6 +161,7 @@ fillDb = do , userSex = Just SexMale , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -195,6 +197,7 @@ fillDb = do , userCsvOptions = def , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -230,6 +233,7 @@ fillDb = do , userSex = Just SexMale , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -265,6 +269,7 @@ fillDb = do , userSex = Just SexNotApplicable , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -300,6 +305,7 @@ fillDb = do , userSex = Just SexFemale , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength @@ -365,6 +371,7 @@ fillDb = do , userSex = Nothing , userShowSex = userDefaultShowSex , userScheduleView = userDefaultScheduleView + , userScheduleWeekDays = userDefaultScheduleWeekDays , userScheduleWeekTimeFrom = userDefaultScheduleWeekTimeFrom , userScheduleWeekTimeTo = userDefaultScheduleWeekTimeTo , userScheduleWeekTimeslotLength = userDefaultScheduleWeekTimeslotLength