-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Occurrences
  ( LessonTime(..)
  , lessonTimeWidget, lessonTimesWidget
  , lessonTimesSpan
  , occurringLessons
  , occurrencesWidget
  , occurrencesCompute, occurrencesCompute'
  , occurrencesBounds
  , occurrencesAddBusinessDays
  ) where

import Import

import qualified Data.Set as Set

import Utils.Holidays (isWeekend)
import Utils.Occurrences

import Handler.Utils.DateTime
import Handler.Utils.Widgets (roomReferenceWidget)

-- import Text.Read (read) -- for DEBUGGING only


----------------
-- LessonTime --
----------------
--
-- Model time intervals to compute lecture/tutorial lessons more intuitively
--

data LessonTime = LessonTime { lessonStart, lessonEnd :: LocalTime, lessonRoom :: Maybe RoomReference }
  deriving (Eq, Ord, Show, Generic, Binary) -- BEWARE: Ord instance might not be intuitive, but needed for Set

occurringLessons :: Term -> Occurrences -> Set LessonTime
occurringLessons term Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept scheduledLessons
  where
    scheduledLessons      = occurrenceScheduleToLessons term `foldMap` occurrencesScheduled
    (exceptOcc, exceptNo) = occurrenceExceptionToLessons  occurrencesExceptions
    isExcept LessonTime{lessonStart} = Set.notMember lessonStart exceptNo

occurrenceScheduleToLessons :: Term -> OccurrenceSchedule -> Set LessonTime
occurrenceScheduleToLessons Term{..} =
  let setHolidays = Set.fromList termHolidays -- ensure that the conversion is performed only once for repeated calls
  in \ScheduleWeekly{..} ->
        let occDays = daysOfWeekBetween (termLectureStart, termLectureEnd) scheduleDayOfWeek \\ setHolidays
            toLesson d = LessonTime { lessonStart = LocalTime d scheduleStart
                                    , lessonEnd   = LocalTime d scheduleEnd
                                    , lessonRoom  = scheduleRoom
                                    }
        in Set.map toLesson occDays

occurrenceExceptionToLessons :: Set OccurrenceException -> (Set LessonTime, Set LocalTime)
occurrenceExceptionToLessons = Set.foldr aux mempty
  where
    aux ExceptOccur{..} (oc,no) =
      let t = LessonTime  { lessonStart = LocalTime exceptDay exceptStart
                          , lessonEnd   = LocalTime exceptDay exceptEnd
                          , lessonRoom  = exceptRoom
                          }
      in (Set.insert t oc,no)
    aux ExceptNoOccur{..} (oc,no) =
      (oc, Set.insert exceptTime no)

lessonTimeWidget :: Bool -> LessonTime -> Widget
lessonTimeWidget roomHidden LessonTime{..} = do
  lStart <- formatTime SelFormatTime lessonStart
  lEnd   <- formatTime SelFormatTime lessonEnd
  $(widgetFile "widgets/lesson/single")

lessonTimesWidget :: (Traversable t, MonoFoldable (t Widget)) => Bool -> t LessonTime -> Widget
lessonTimesWidget roomHidden lessonsSet = do
  let lessons = lessonTimeWidget roomHidden <$> lessonsSet
  $(widgetFile "widgets/lesson/set")

lessonTimesSpan :: Set LessonTime -> Maybe (Day, Day)
lessonTimesSpan ls = comb (Set.lookupMin lDays, Set.lookupMax lDays)
  where
    lDays = Set.foldr accDay mempty ls
    accDay LessonTime{..} = Set.insert (localDay lessonStart) . Set.insert (localDay lessonEnd)
    comb (Just x, Just y) = Just (x,y)
    comb _ = Nothing


-----------------
-- Occurrences --
-----------------

occurrencesWidget :: Bool -> JSONB Occurrences -> Widget
occurrencesWidget roomHidden (normalizeOccurrences . unJSONB -> 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 all days of occurrences during a term, excluding term holidays from the regular schedule, but not from do-occur exceptions
occurrencesCompute :: Term -> Occurrences -> Set Day
occurrencesCompute trm occ = Set.map (localDay . lessonStart) $ occurringLessons trm occ

-- | Less precise versison of `occurrencesCompute`, which ignores TimeOfDay; might be faster, but could be wrong in some cases
occurrencesCompute' :: Term -> Occurrences -> Set Day
occurrencesCompute' Term{..} Occurrences{..} = ((scdDays \\ Set.fromList termHolidays) <> plsDays) \\ excDays
  where
    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

-- | Get bounds for an Occurrences
occurrencesBounds :: Term -> Occurrences -> (Maybe Day, Maybe Day)
occurrencesBounds = (liftM2 (,) Set.lookupMin Set.lookupMax .) . occurrencesCompute

occurrencesAddBusinessDays :: Term -> (Day,Day) -> Occurrences -> Occurrences
occurrencesAddBusinessDays Term{..} (dayOld, dayNew) Occurrences{..} = Occurrences newSchedule newExceptions
  where
    newSchedule = Set.map switchDayOfWeek occurrencesScheduled
    dayDiff = diffDays dayNew dayOld

    offDays = Set.fromList $ termHolidays <> weekends
    weekends = [d | d <- [(min termLectureStart termStart)..(max termEnd termLectureEnd)], isWeekend d]

    switchDayOfWeek :: OccurrenceSchedule -> OccurrenceSchedule
    switchDayOfWeek os | 0 == dayDiff `mod` 7 = os
    switchDayOfWeek os@ScheduleWeekly{scheduleDayOfWeek=wday} = os{scheduleDayOfWeek= toEnum (fromIntegral dayDiff + fromEnum wday)}

    newExceptions = snd $ Set.foldl' advanceExceptions (dayDiff,mempty) occurrencesExceptions

    -- we assume that instance Ord OccurrenceException is ordered chronologically
    advanceExceptions :: (Integer, Set OccurrenceException) -> OccurrenceException -> (Integer, Set OccurrenceException)
    advanceExceptions (offset, acc) ex
        | ed `Set.notMember` offDays   -- skip term-holidays and weekends, unless the original day was a holiday or weekend
        , nd `Set.member`    offDays
          = advanceExceptions (succ offset, acc) ex
        | otherwise
          = (offset, Set.insert (setDayOfOccurrenceException nd ex) acc)
      where
        ed = dayOfOccurrenceException ex
        nd = addDays offset ed



{-

-----------
-- DEBUG --
-----------
theorieschulung :: Occurrences
theorieschulung =
   Occurrences
    {occurrencesScheduled = Set.fromList
      [ScheduleWeekly {scheduleDayOfWeek = Thursday, scheduleStart = read "11:11:00", scheduleEnd = read "12:22:00"}
      ,ScheduleWeekly {scheduleDayOfWeek = Friday  , scheduleStart = read "13:33:00", scheduleEnd = read "14:44:00"}
      ,ScheduleWeekly {scheduleDayOfWeek = Sunday  , scheduleStart = read "15:55:00", scheduleEnd = read "16:06:00"}
      ]
    , occurrencesExceptions = Set.fromList
      [ExceptOccur {exceptDay = read "2024-01-07", exceptStart = read "08:30:00", exceptEnd = read "16:00:00"}
      ,ExceptOccur {exceptDay = read "2024-01-15", exceptStart = read "09:00:00", exceptEnd = read "16:00:00"}
      ,ExceptOccur {exceptDay = read "2024-09-24", exceptStart = read "09:10:00", exceptEnd = read "16:10:00"}
      ,ExceptNoOccur {exceptTime = read "2024-02-25 15:55:00"}
      ,ExceptNoOccur {exceptTime = read "2024-10-25 13:33:00"}
      ,ExceptNoOccur {exceptTime = read "2024-11-08 08:08:08"} -- causes difference between occurrencesCompute and occurrencesCompute'
      ,ExceptNoOccur {exceptTime = read "2024-11-09 11:11:08"}
      ]
    }

exampleTerm :: Term
exampleTerm = Term
  { termName = TermIdentifier {year = 2024}
  , termStart = read "2024-01-01"
  , termEnd   = read "2024-12-29"
  , termHolidays = [read "2024-01-01", read "2024-03-29", read "2024-03-31", read "2024-04-01", read "2024-05-01", read "2024-05-09"
                   ,read "2024-05-19", read "2024-05-20", read "2024-05-30", read "2024-10-03", read "2024-12-24", read "2024-12-25", read "2024-12-26" ]
  , termLectureStart = read "2024-01-01"
  , termLectureEnd   = read "2024-12-27"
  }

-}