feat: displayed weekdays in settings

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

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

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

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

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

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

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

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

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

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

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