From 428b8cf739bf3929a16800e53af5cade15174870 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel <> Date: Fri, 21 Aug 2020 17:14:56 +0200 Subject: [PATCH] refactor(schedule-week): remove deprecated week messages --- messages/uniworx/de-de-formal.msg | 16 ----------- messages/uniworx/en-eu.msg | 16 ----------- src/Utils/Schedule/Week.hs | 37 ++++++++++---------------- templates/widgets/schedule/week.hamlet | 6 ++--- 4 files changed, 17 insertions(+), 58 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index d415ace68..e9c1e2509 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -112,22 +112,6 @@ ScheduleTime: Zeit ScheduleOccur: Findet statt ScheduleNoOccur: Findet nicht statt -ScheduleWeekDayMonday: Montag -ScheduleWeekDayTuesday: Dienstag -ScheduleWeekDayWednesday: Mittwoch -ScheduleWeekDayThursday: Donnerstag -ScheduleWeekDayFriday: Freitag -ScheduleWeekDaySaturday: Samstag -ScheduleWeekDaySunday: Sonntag - -ScheduleWeekDayMondayShort: Mo -ScheduleWeekDayTuesdayShort: Di -ScheduleWeekDayWednesdayShort: Mi -ScheduleWeekDayThursdayShort: Do -ScheduleWeekDayFridayShort: Fr -ScheduleWeekDaySaturdayShort: Sa -ScheduleWeekDaySundayShort: So - SchoolListHeading: Übersicht über verwaltete Institute SchoolHeading school@SchoolName: Übersicht #{school} diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 99aab8438..98f3d0ae6 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -112,22 +112,6 @@ ScheduleTime: Time ScheduleOccur: Does occur ScheduleNoOccur: Does not occur -ScheduleWeekDayMonday: Monday -ScheduleWeekDayTuesday: Tuesday -ScheduleWeekDayWednesday: Wednesday -ScheduleWeekDayThursday: Thursday -ScheduleWeekDayFriday: Friday -ScheduleWeekDaySaturday: Saturday -ScheduleWeekDaySunday: Sunday - -ScheduleWeekDayMondayShort: Mon -ScheduleWeekDayTuesdayShort: Tue -ScheduleWeekDayWednesdayShort: Wed -ScheduleWeekDayThursdayShort: Thu -ScheduleWeekDayFridayShort: Fri -ScheduleWeekDaySaturdayShort: Sat -ScheduleWeekDaySundayShort: Sun - SchoolListHeading: Department SchoolHeading school: #{school} diff --git a/src/Utils/Schedule/Week.hs b/src/Utils/Schedule/Week.hs index ebcb37e43..309e8978b 100644 --- a/src/Utils/Schedule/Week.hs +++ b/src/Utils/Schedule/Week.hs @@ -20,10 +20,9 @@ import Utils.Schedule.Types import Utils.Schedule.Week.TimeSlot --- TODO: implement weekOffset --- TODO: use more general dayOffset instead of weekOffset -weekSchedule :: UserId -> Maybe Int -> Widget -weekSchedule uid _weekOffset = do +-- TODO: implement dayOffset +weekSchedule :: UserId -> Maybe Integer -> Widget +weekSchedule uid _dayOffset = do now <- liftIO getCurrentTime tz <- liftIO getCurrentTimeZone ata <- getSessionActiveAuthTags @@ -132,7 +131,7 @@ weekSchedule uid _weekOffset = do && seeoStart < nextSlotUTCTime events' :: Map Day (Map TimeSlot [ScheduleEntry]) - events' = Map.fromList $ currentWeek <&> \day -> + events' = Map.fromList $ week <&> \day -> ( day , Map.fromList $ slotsToDisplay <&> \slot -> ( slot @@ -164,26 +163,13 @@ weekSchedule uid _weekOffset = do _ -> True -- TODO: maybe filter out ExceptNoOccurs? (Should NoOccurs be displayed or not?) in filter isRegularWithoutException occurrencesInSlot - -- TODO: Internationalize week start (and/or make configurable) + -- TODO: Internationalize default week start (and/or make configurable) -- TODO: auto-hide saturday and sunday (if there are no events scheduled)? - -- TODO: weekday messages deprecated / not used => remove - - currentWeek :: [Day] - currentWeek = currentWeekAux $ utctDay now - where currentWeekAux day + week :: [Day] + week = go $ utctDay now + where go day | Monday <- dayOfWeek day = [day .. toEnum (fromEnum day + 6)] - | otherwise = currentWeekAux $ pred day - - weekDays :: [(Day, UniWorXMessage, Text)] - weekDays = zipWith (\x (y,z) -> (x,y,z)) currentWeek - [ (MsgScheduleWeekDayMonday , "mon") - , (MsgScheduleWeekDayTuesday , "tue") - , (MsgScheduleWeekDayWednesday , "wed") - , (MsgScheduleWeekDayThursday , "thu") - , (MsgScheduleWeekDayFriday , "fri") - , (MsgScheduleWeekDaySaturday , "sat") - , (MsgScheduleWeekDaySunday , "sun") - ] + | otherwise = go $ pred day $(widgetFile "widgets/schedule/week") @@ -205,6 +191,11 @@ formatOccurrenceW = \case Right (Left ExceptNoOccur{}) -> [whamlet| _{MsgScheduleNoOccur} |] -- <> formatTimeW SelFormatDateTime exceptTime Left ScheduleEntryExamOccurrence{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime seeoStart seeoEnd +-- | Uniquely identify each day as table head +-- | This avoids constantly hiding e.g. some DayOfWeek (which would interfere with day offsets) +dayTableHeadIdent :: Day -> Text +dayTableHeadIdent = tshow . toModifiedJulianDay + -- | Convert from DayOfWeek to Day of this week using the current time (as UTCTime) dayOfWeekToDayWith :: DayOfWeek -> UTCTime -> Day dayOfWeekToDayWith weekDay = go . utctDay where diff --git a/templates/widgets/schedule/week.hamlet b/templates/widgets/schedule/week.hamlet index eb544910f..06074ed0d 100644 --- a/templates/widgets/schedule/week.hamlet +++ b/templates/widgets/schedule/week.hamlet @@ -5,15 +5,15 @@ $newline never _{MsgScheduleTableHeadTime} - $forall (day, _, weekDayIdent) <- weekDays - + $forall day <- week + ^{formatTimeW SelFormatDate day} $forall slot <- slotsToDisplay ^{formatTimeSlotW slot} - $forall (day, _, _) <- weekDays + $forall day <- week
$maybe dayEvents <- Map.lookup day events