80 lines
3.6 KiB
Haskell
80 lines
3.6 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Utils.Occurrences
|
|
( occurrencesWidget
|
|
, occurrencesBounds
|
|
-- , occurrencesAddBusinessDays
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
-- import Utils.Holidays (isWeekend)
|
|
import Utils.Occurrences
|
|
|
|
import Handler.Utils.DateTime
|
|
|
|
|
|
occurrencesWidget :: Occurrences -> Widget
|
|
occurrencesWidget (normalizeOccurrences -> Occurrences{..}) = do
|
|
let occurrencesScheduled' = flip map (Set.toList occurrencesScheduled) $ \case
|
|
ScheduleWeekly{..} -> do
|
|
scheduleStart' <- formatTime SelFormatTime scheduleStart
|
|
scheduleEnd' <- formatTime SelFormatTime scheduleEnd
|
|
$(widgetFile "widgets/occurrence/cell/weekly")
|
|
occurrencesExceptions' = flip map (Set.toList occurrencesExceptions) $ \case
|
|
ExceptOccur{..} -> do
|
|
exceptStart' <- formatTime SelFormatDateTime (LocalTime exceptDay exceptStart)
|
|
exceptEnd' <- formatTime SelFormatTime exceptEnd
|
|
$(widgetFile "widgets/occurrence/cell/except-occur")
|
|
ExceptNoOccur{..} -> do
|
|
exceptTime' <- formatTime SelFormatDateTime exceptTime
|
|
$(widgetFile "widgets/occurrence/cell/except-no-occur")
|
|
$(widgetFile "widgets/occurrence/cell")
|
|
|
|
-- | Get bounds for an Occurrences
|
|
occurrencesBounds :: Term -> Occurrences -> (Maybe Day, Maybe Day)
|
|
occurrencesBounds Term{..} Occurrences{..} = (Set.lookupMin occDays, Set.lookupMax occDays)
|
|
where
|
|
occDays = (scdDays <> plsDays) \\ excDays -- (excDays <> termHolidays term) -- TODO: should holidays be exluded here? Probably not, as they can be added as exceptions already
|
|
|
|
scdDays = Set.foldr getOccDays mempty occurrencesScheduled
|
|
(plsDays,excDays) = Set.foldr getExcDays mempty occurrencesExceptions
|
|
|
|
getExcDays :: OccurrenceException -> (Set Day, Set Day) -> (Set Day, Set Day)
|
|
getExcDays ExceptNoOccur{exceptTime} (occ,exc) = (occ, Set.insert (localDay exceptTime) exc)
|
|
getExcDays ExceptOccur{exceptDay} (occ,exc) = (Set.insert exceptDay occ, exc)
|
|
|
|
getOccDays :: OccurrenceSchedule -> Set Day -> Set Day
|
|
getOccDays ScheduleWeekly{scheduleDayOfWeek=wday} = Set.union $ daysOfWeekBetween (termLectureStart,termLectureEnd) wday
|
|
|
|
-- occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> Occurrences
|
|
-- occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrences newSchedule newExceptions
|
|
-- where
|
|
-- newSchedule = Set.map switchDayOfWeek occurrencesScheduled
|
|
-- dayDiff = diffDays dayNew dayOld
|
|
|
|
-- switchDayOfWeek :: OccurrenceSchedule -> OccurrenceSchedule
|
|
-- switchDayOfWeek _ | 0 == dayDiff `mod` 7 = id
|
|
-- switchDayOfWeek os@ScheduleWeekly{scheduleDayOfWeek=wday} = os{scheduleDayOfWeek= toEnum (dayDiff + fromEnum wday)}
|
|
|
|
-- newExceptions = snd $ Set.foldr advanceExceptions (dayDiff,mempty) occurrencesExceptions
|
|
|
|
-- advanceExceptions :: OccurrenceException -> (Integer, Set OccurrenceException) -> (Integer, Set OccurrenceException)
|
|
-- advanceExceptions ex@ExceptOccur{ exceptDay = ed } (offset, acc) =
|
|
-- | add
|
|
|
|
|
|
-- advanceExceptions ex@ExceptOccur{ exceptDay = ed } = ex{ exceptDay = pushSkip ed }
|
|
-- advanceExceptions ex@ExceptNoOccur{ exceptTime = et@LocalTime { localDay = ed } } = ex{ exceptDay = et{ localDay = pushSkip ed}}
|
|
|
|
-- pushSkip
|
|
-- pushSkip :: Day -> Day
|
|
-- pushSkip = id -- TODO
|
|
-- -- pushSkip = let weekends = [d | d <- [(min termLectureStart termStart)..(max termEnd termLectureEnd)], isWeekend d]
|
|
-- -- offDays = Set.fromList $ termHolidays <> weekends
|
|
|
|
-- -- in |