module Utils.Schedule
  ( fetchActiveTerms, fetchCourseEventsScheduleInfo, fetchTutorialsScheduleInfo, fetchExamOccurrencesScheduleInfo
  , courseEventShouldBeDisplayedInSchedule, tutorialShouldBeDisplayedInSchedule, examOccurrenceShouldBeDisplayedInSchedule
  ) where

import Import

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import Handler.Utils.Course (showCourseEventRoom)
import Handler.Utils.Exam (showExamOccurrenceRoom)
import Handler.Utils.Tutorial (showTutorialRoom)

import Utils.Course
import Utils.Tutorial

import Utils.Schedule.Types


-- TODO: move to general utils or use general utils function if available
fetchActiveTerms :: MonadHandler m => ReaderT SqlBackend m [Entity Term]
fetchActiveTerms = E.select $ E.from $ \term -> do
  E.where_ $ term E.^. TermActive
  return term

fetchCourseEventsScheduleInfo :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleCourseEventInfo]
fetchCourseEventsScheduleInfo muid ata now = E.select $ E.from $ \(course `E.InnerJoin` courseEvent) -> do
  E.on $ course E.^. CourseId E.==. courseEvent E.^. CourseEventCourse
  E.where_ $ courseEventShouldBeDisplayedInSchedule muid ata course courseEvent
    E.&&.    mayViewCourse muid ata now course Nothing  -- should not be necessary, but let's be on the safe side
  let showRoom = maybe E.false (flip showCourseEventRoom courseEvent . E.val) muid
           E.||. E.not_ (courseEvent E.^. CourseEventRoomHidden)
  return (course, courseEvent, showRoom)

fetchTutorialsScheduleInfo :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleTutorialInfo]
fetchTutorialsScheduleInfo muid ata now = E.select $ E.from $ \(course `E.InnerJoin` tutorial) -> do
  E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
  E.where_ $ tutorialShouldBeDisplayedInSchedule muid ata course tutorial
    E.&&.    mayViewCourse muid ata now course Nothing  -- should not be necessary, but let's be on the safe side
  let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) muid
           E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
  return (course, tutorial, showRoom)

fetchExamOccurrencesScheduleInfo :: MonadHandler m => Maybe UserId -> AuthTagActive -> UTCTime -> ReaderT SqlBackend m [ScheduleExamOccurrenceInfo]
fetchExamOccurrencesScheduleInfo muid ata now = E.select $ E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examOccurrence) -> do
    E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
    E.on $ exam E.^. ExamId E.==. examOccurrence E.^. ExamOccurrenceExam
    E.where_ $ examOccurrenceShouldBeDisplayedInSchedule muid ata now course exam examOccurrence
    let showRoom = maybe E.false (flip showExamOccurrenceRoom examOccurrence . E.val) muid
             E.||. E.not_ (examOccurrence E.^. ExamOccurrenceRoomHidden)
    return (course, exam, examOccurrence, showRoom)


courseEventShouldBeDisplayedInSchedule :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity CourseEvent) -> E.SqlExpr (E.Value Bool)
courseEventShouldBeDisplayedInSchedule muid@(Just uid) ata course courseEvent = E.exists . E.from $ \user -> 
  let
    mCourseEventOpt = E.subSelect . E.from $ \courseEventScheduleOpt -> do
      E.where_ $ courseEventScheduleOpt E.^. CourseEventScheduleOptCourseEvent E.==. courseEvent E.^. CourseEventId
           E.&&. courseEventScheduleOpt E.^. CourseEventScheduleOptUser E.==. user E.^. UserId
      return $ courseEventScheduleOpt E.^. CourseEventScheduleOptOpt
    mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
  in E.where_ $ user E.^. UserId E.==. E.val uid
       E.&&. E.fromMaybe
             ( E.fromMaybe
               ( user E.^. UserScheduleOccurrenceDisplayDefault
                 E.&&. ( isCourseParticipant muid ata (course E.^. CourseId)
                   E.||. isCourseLecturer    muid ata (course E.^. CourseId)
                 )
               )
               mCourseOpt
             )
             mCourseEventOpt
courseEventShouldBeDisplayedInSchedule _ _ _ _ = E.false

tutorialShouldBeDisplayedInSchedule :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Tutorial) -> E.SqlExpr (E.Value Bool)
tutorialShouldBeDisplayedInSchedule muid@(Just uid) ata course tutorial = E.exists . E.from $ \user ->
  let
    mTutorialOpt = E.subSelect . E.from $ \tutorialScheduleOpt -> do
      E.where_ $ tutorialScheduleOpt E.^. TutorialScheduleOptTutorial E.==. tutorial E.^. TutorialId
           E.&&. tutorialScheduleOpt E.^. TutorialScheduleOptUser E.==. user E.^. UserId
      return $ tutorialScheduleOpt E.^. TutorialScheduleOptOpt
    mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
  in E.where_ $ user E.^. UserId E.==. E.val uid
       E.&&. E.fromMaybe
             ( ( E.fromMaybe
                 (user E.^. UserScheduleOccurrenceDisplayDefault)
                 mCourseOpt
               ) E.&&. (  isTutorialTutor       muid ata (tutorial E.^. TutorialId)
                   E.||.  isTutorialParticipant muid ata (tutorial E.^. TutorialId)
               )
             )
             mTutorialOpt
tutorialShouldBeDisplayedInSchedule _ _ _ _ = E.false

examOccurrenceShouldBeDisplayedInSchedule :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (Entity Exam) -> E.SqlExpr (Entity ExamOccurrence) -> E.SqlExpr (E.Value Bool)
examOccurrenceShouldBeDisplayedInSchedule muid@(Just uid) ata now course exam examOcc = E.exists . E.from $ \user ->
  let
    mExamOccOpt = E.subSelect . E.from $ \examOccScheduleOpt -> do
      E.where_ $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptExamOccurrence E.==. examOcc E.^. ExamOccurrenceId
           E.&&. examOccScheduleOpt E.^. ExamOccurrenceScheduleOptUser E.==. user E.^. UserId
      return $ examOccScheduleOpt E.^. ExamOccurrenceScheduleOptOpt
    
    mCourseOpt = E.subSelect $ getCourseScheduleOpt course user
  in E.where_ $ user E.^. UserId E.==. E.val uid
       E.&&. E.fromMaybe
             ( ( E.fromMaybe
                 (user E.^. UserScheduleOccurrenceDisplayDefault)
                 mCourseOpt
               ) E.&&.   ( isCourseLecturer muid ata (course E.^. CourseId)
                   E.||. ( mayViewCourse muid ata now course Nothing  -- do NOT remove, this is actually necessary here!
                                                                      -- (There can be exam participants that are 
                                                                      --  not enrolled, me thinks)
                           E.&&. E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (exam E.^. ExamVisibleFrom)  -- is the exam visible?
                           E.&&. E.maybe E.false (\publishOcc  -> publishOcc  E.<=. E.val now) (exam E.^. ExamPublishOccurrenceAssignments)  -- are the exam occurrence assignments visible?
                           E.&&. (E.exists $ E.from $ \examRegistration -> E.where_ $
                                   examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
                             E.&&. E.just (examRegistration E.^. ExamRegistrationUser) E.==. E.val muid
                             E.&&. E.maybe E.true (\registrationOccurrence -> E.maybe E.false (const E.true) mExamOccOpt E.||. registrationOccurrence E.==. examOcc E.^. ExamOccurrenceId) (examRegistration E.^. ExamRegistrationOccurrence)  -- if registered for a specific occurrence, get only this one and occurrences with an opt-in, otherwise get every occurrence available
                           )
                   )
               )
             )
             mExamOccOpt
examOccurrenceShouldBeDisplayedInSchedule _ _ _ _ _ _ = E.false


-- Local helper functions

getCourseScheduleOpt :: E.SqlExpr (Entity Course) -> E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (E.Value Bool))
getCourseScheduleOpt course user = E.from $ \courseScheduleOpt -> do
  E.where_ $ courseScheduleOpt E.^. CourseScheduleOptCourse E.==. course E.^. CourseId
    E.&&.    courseScheduleOpt E.^. CourseScheduleOptUser   E.==. user   E.^. UserId
  return $   courseScheduleOpt E.^. CourseScheduleOptOpt
