module Utils.Schedule.Week
  ( weekSchedule
  ) where

import Import

import qualified Data.CaseInsensitive as CI

import qualified Data.Map as Map
import qualified Data.Set as Set

import qualified Database.Esqueleto as E

import Handler.Utils.DateTime (formatTimeRangeW, formatTimeW)

import Utils.Schedule
import Utils.Schedule.Types
import Utils.Schedule.Week.TimeSlot


weekSchedule :: Entity User -> ScheduleOffset -> Widget
weekSchedule (Entity uid User{userWeekStart}) scheduleOffset = do
  now <- liftIO getCurrentTime
  tz  <- liftIO getCurrentTimeZone
  ata <- getSessionActiveAuthTags

  let
    dayOffset = case scheduleOffset of
      ScheduleOffsetNone     -> 0
      ScheduleOffsetDays   d -> d
    dayNowOffset = toInteger dayOffset `addDays` utctDay now

  -- TODO: single runDB for all fetches below?
  
  activeTerms <- liftHandler $ runDB fetchActiveTerms

  -- TODO: fetch course events for this week only?
  courseEvents <- liftHandler $ runDB $ fetchCourseEvents (Just uid) ata now
  tutorials <- liftHandler $ runDB $ fetchTutorials (Just uid) ata now
  -- TODO: this makes the exam table partly redundant => maybe remove?
  examOccurrences <- liftHandler . runDB $ fetchExamOccurrences (Just uid) ata now
  
  let
    courseEventToScheduleEntries :: ScheduleCourseEventInfo -> [ScheduleEntry]
    courseEventToScheduleEntries (sceCourse@(Entity _ Course{..}), Entity _ CourseEvent{courseEventType=sceType,courseEventRoom=sceRoom,courseEventTime=Occurrences{..}}) =
      let scheduleds
            -- omit regular occurrences if the course term is not currently active
            | not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
            | otherwise = Set.toList occurrencesScheduled  <&> \scheduled ->
                            let sceOccurrence = Right scheduled in ScheduleCourseEvent{..}
          exceptions    = Set.toList occurrencesExceptions <&> \exception ->
                            let sceOccurrence = Left  exception in ScheduleCourseEvent{..}
      in  scheduleds <> exceptions

    tutorialToScheduleEntries :: ScheduleTutorialInfo -> [ScheduleEntry]
    tutorialToScheduleEntries (stCourse@(Entity _ Course{..}), Entity _ Tutorial{tutorialName=stName,tutorialType=stType,tutorialRoom=stRoom,tutorialTime=Occurrences{..}}) =
      let scheduleds
            -- omit regular occurrences if the course term is not currently active
            | not (courseTerm `elem` (E.unValue <$> activeTerms)) = mempty
            | otherwise = Set.toList occurrencesScheduled  <&> \scheduled ->
                            let stOccurrence = Right scheduled in ScheduleTutorial{..}
          exceptions    = Set.toList occurrencesExceptions <&> \exception ->
                            let stOccurrence = Left  exception in ScheduleTutorial{..}
      in  scheduleds <> exceptions

    -- TODO: introduce type synonym for (Entity Course, Entity Exam, Entity ExamOccurrence)?
    joinParallelExamOccurrences :: [ScheduleExamOccurrenceInfo] -> [ScheduleExamOccurrenceJoinedInfo]
    joinParallelExamOccurrences = go [] where
      go acc [] = acc
      go acc (examOcc@(course, exam, occ):examOccs) =
        let ((((view _3) <$>) -> parallel), other) = partition (examOcc `isParallelTo`) examOccs
        in  go ((course, exam, occ:|parallel):acc) other
      (Entity cid _, Entity eid _, Entity _ occ) `isParallelTo` (Entity cid' _, Entity eid' _, Entity _ occ') =
           cid == cid' && eid == eid'
        && examOccurrenceStart occ == examOccurrenceStart occ' && examOccurrenceEnd occ == examOccurrenceEnd occ'
    
    examOccurrenceToScheduleEntry :: ScheduleExamOccurrenceJoinedInfo -> ScheduleEntry
    examOccurrenceToScheduleEntry (seoCourse@(Entity _ Course{}), Entity _ Exam{examName=seoExamName}, examOccs@((Entity _ occ):|_)) =
      let seoRooms = (examOccurrenceRoom . entityVal) <$> examOccs
          seoStart =  examOccurrenceStart occ  -- multiple exam occurrences are joined on equality of start and end,
          seoEnd   =  examOccurrenceEnd   occ  -- so taking the timestamps of the first occurrence suffices
      in  ScheduleExamOccurrence{..}
    
    events' :: Map Day (Map TimeSlot [ScheduleEntry])
    events' = Map.fromList $ week <&> \d ->
      ( d
      , Map.fromList $ allTimeSlots <&> \slot ->
        ( slot
        , filter (seIsInSlot tz d slot) scheduleEntries
        )
      ) where
        scheduleEntries = join $ (courseEventToScheduleEntries  <$> courseEvents)
                         <>      (tutorialToScheduleEntries     <$> tutorials)
                         <> pure (examOccurrenceToScheduleEntry <$> (joinParallelExamOccurrences examOccurrences))

    events :: Map Day (Map TimeSlot [ScheduleEntry])
    events = events' <&> \slotsPerDay -> slotsPerDay <&> \occurrencesInSlot ->
      let
        isRegularWithoutException :: ScheduleEntry -> Bool
        isRegularWithoutException =
          let -- remove regular occurrences if there is a NoOccur exception for the occurrence of this week
              goPrune (Right ScheduleWeekly{..}) = not $ ExceptNoOccur (LocalTime (scheduleDayOfWeek `dayOfWeekToDayWith` dayNowOffset) scheduleStart) `elem` (catMaybes $ scheduleEntryToNoOccur <$> occurrencesInSlot)
              -- remove NoOccur exceptions if there is no regular occurrence to override
              goPrune (Left ExceptNoOccur{exceptTime=LocalTime{..}}) =
                any (\ScheduleWeekly{..} -> scheduleDayOfWeek `dayOfWeekToDayWith` dayNowOffset == localDay
                                           && scheduleStart == localTimeOfDay
                  ) (catMaybes $ scheduleEntryToRegular <$> occurrencesInSlot)
              goPrune _ = True  -- TODO: maybe filter NoOccur exceptions in general? (Should NoOccur exceptions be displayed?)
          in \case
            ScheduleCourseEvent{sceOccurrence} -> goPrune sceOccurrence
            ScheduleTutorial{stOccurrence} -> goPrune stOccurrence
            _ -> True
      in filter isRegularWithoutException occurrencesInSlot

    -- TODO: auto-hide saturday and sunday (if there are no events scheduled)?
    week :: [Day]
    week = go dayNowOffset
      where go d
              | dayOfWeek d == firstDay = [d .. toEnum (fromEnum d + 6)]
              | otherwise = go $ pred d
            firstDay = toEnum $ fromEnum userWeekStart + dayOffset

    -- TODO: make this configurable
    timeSlotsDefaultDisplay :: Set TimeSlot
    timeSlotsDefaultDisplay = Set.fromList $ timeSlotsFromTo 8 18

    allTimeSlots :: [TimeSlot]
    allTimeSlots = timeSlotsFromTo 0 22

    timeSlotIsEmpty :: TimeSlot -> Bool
    timeSlotIsEmpty slot = foldr (\d acc -> acc && maybe True null (d Map.!? slot)) True events

  $(widgetFile "schedule/week")


-- Local helper functions

-- | Check whether a given ScheduleEntry lies in a given TimeSlot
seIsInSlot :: TimeZone -> Day -> TimeSlot -> ScheduleEntry -> Bool
seIsInSlot tz d slot =
  let occurrenceIsInSlot occurrence = occDay == d && occTime `isInTimeSlot` slot where
        (occDay, occTime) = case occurrence of
                              Right ScheduleWeekly{..} -> (scheduleDayOfWeek `dayOfWeekToDayWith` d, scheduleStart)
                              Left ExceptOccur{..} -> (exceptDay, exceptStart)
                              Left ExceptNoOccur{exceptTime=LocalTime{..}} -> (localDay, localTimeOfDay)
  in \case
    ScheduleCourseEvent{sceOccurrence} -> occurrenceIsInSlot sceOccurrence
    ScheduleTutorial{stOccurrence}     -> occurrenceIsInSlot stOccurrence
    ScheduleExamOccurrence{seoStart}   -> let (slotTime,nextSlotTime) = timeSlotToUTCTime tz d slot
                                          in slotTime <= seoStart
                                             && seoStart < nextSlotTime

-- | Maybe get the OccurrenceSchedule of a given ScheduleEntry
scheduleEntryToRegular :: ScheduleEntry -> Maybe OccurrenceSchedule
scheduleEntryToRegular = \case
  ScheduleCourseEvent{sceOccurrence=Right schedule} -> Just schedule
  ScheduleTutorial{stOccurrence=Right schedule} -> Just schedule
  _ -> Nothing

-- | Maybe get an ExceptNoOccur OccurrenceException of a given ScheduleEntry
scheduleEntryToNoOccur :: ScheduleEntry -> Maybe OccurrenceException
scheduleEntryToNoOccur = \case
  ScheduleCourseEvent{sceOccurrence=Left noOccur@ExceptNoOccur{}} -> Just noOccur
  ScheduleTutorial{stOccurrence=Left noOccur@ExceptNoOccur{}} -> Just noOccur
  _ -> Nothing

-- | To which route should each schedule entry link to?
scheduleEntryToHref :: ScheduleEntry -> Route UniWorX
scheduleEntryToHref = \case
  ScheduleCourseEvent{sceCourse=(Entity _ Course{..})} -> CourseR courseTerm courseSchool courseShorthand CShowR  -- TODO: link to events table? (currently has no id)
  ScheduleTutorial{stCourse=(Entity _ Course{..})} -> CourseR courseTerm courseSchool courseShorthand CShowR  -- TODO: link to table with id "tutorials"?
  ScheduleExamOccurrence{seoCourse=(Entity _ Course{..}),seoExamName} -> CExamR courseTerm courseSchool courseShorthand seoExamName EShowR

-- | Calls formatTimeRangeW with the correct arguments and prepends an occurrence descriptor based on the occurrence type
formatEitherOccurrenceW :: Either OccurrenceException OccurrenceSchedule -> Widget
formatEitherOccurrenceW = \case
  Right ScheduleWeekly{..} -> [whamlet| _{MsgScheduleTime}: |] <> formatTimeRangeW SelFormatTime scheduleStart (Just scheduleEnd)
  Left ExceptOccur{..} -> [whamlet| _{MsgScheduleOccur}: |] <> formatTimeRangeW SelFormatTime (LocalTime exceptDay exceptStart) (Just $ LocalTime exceptDay exceptEnd)
  Left ExceptNoOccur{} -> [whamlet| _{MsgScheduleNoOccur} |]  -- <> formatTimeW SelFormatDateTime exceptTime

-- | 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 day
dayOfWeekToDayWith :: DayOfWeek -> Day -> Day
dayOfWeekToDayWith weekDay = go where
  go d | weekDay' == weekDay = d
       | weekDay' >  weekDay = go $ pred d
       | otherwise           = go $ succ d
       where weekDay' = dayOfWeek d