module Utils.Course
  ( mayViewCourse, mayViewCourse', mayEditCourse, mayEditCourse'
  , isSchoolAdmin, isSchoolAdminLike
  , isCourseLecturer, isCourseTutor, isCourseSheetCorrector, isCourseExamCorrector
  , isCourseParticipant, isCourseApplicant
  , isCourseAssociated
  , courseIsVisible, courseIsVisible'
  , courseAllocationRegistrationOpen
  , numCourseParticipants
  ) where

import Import.NoFoundation

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


mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
mayViewCourse muid ata now course maid = 
        isSchoolAdminLike  muid ata (course E.^. CourseSchool)
  E.||. mayEditCourse      muid ata  course
  E.||. isCourseAssociated muid ata (course E.^. CourseId) maid
  E.||. courseIsVisible         now  course                maid

mayViewCourse' :: Maybe UserId -> AuthTagActive -> UTCTime -> Entity Course -> Maybe AllocationId -> E.SqlExpr (E.Value Bool)
mayViewCourse' muid ata now c@(Entity cid Course{courseSchool}) maid = 
        isSchoolAdminLike  muid ata (E.val courseSchool)
  E.||. mayEditCourse'     muid ata  c
  E.||. isCourseAssociated muid ata (E.val cid) (E.val maid)
  E.||. courseIsVisible'        now  c           maid


mayEditCourse :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
mayEditCourse muid ata course = 
        isSchoolAdmin    muid ata (course E.^. CourseSchool)
  E.||. isCourseLecturer muid ata (course E.^. CourseId)

mayEditCourse' :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
mayEditCourse' muid ata (Entity cid Course{..}) = 
        isSchoolAdmin    muid ata (E.val courseSchool)
  E.||. isCourseLecturer muid ata (E.val cid)


isSchoolAdmin :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdmin muid AuthTagActive{..} ssh
  | Just uid <- muid, authTagIsActive AuthAdmin = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
    E.where_ $ user      E.^. UserId               E.==. E.val uid
      E.&&. userFunction E.^. UserFunctionSchool   E.==. ssh
      E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
  | otherwise = E.false

isSchoolAdminLike :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdminLike muid ata@AuthTagActive{..} ssh
  | Just uid <- muid = isSchoolAdmin muid ata ssh E.||. (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
    E.where_ $ user         E.^. UserId               E.==. E.val uid
      E.&&.    userFunction E.^. UserFunctionSchool   E.==. ssh
      E.&&. ( (userFunction E.^. UserFunctionFunction E.==. E.val SchoolEvaluation
          E.&&. E.val (authTagIsActive AuthEvaluation))
        E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
          E.&&. E.val (authTagIsActive AuthExamOffice))
        E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolAllocation
          E.&&. E.val (authTagIsActive AuthAllocationAdmin))
      )
    )
  | otherwise = E.false

isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseLecturer muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthLecturer = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
    E.on $     user  E.^. UserId         E.==. lecturer E.^. LecturerUser
    E.where_ $ user  E.^. UserId         E.==. E.val uid
      E.&&. lecturer E.^. LecturerCourse E.==. cid
  | otherwise = E.false

isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseTutor muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
    E.on $     tutor E.^. TutorTutorial  E.==. tutorial E.^. TutorialId
    E.where_ $ tutor E.^. TutorUser      E.==. E.val uid
      E.&&. tutorial E.^. TutorialCourse E.==. cid
  | otherwise = E.false

isCourseSheetCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseSheetCorrector muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthCorrector = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
    E.on $     sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
    E.where_ $ sheetCorrector E.^. SheetCorrectorUser  E.==. E.val uid
      E.&&.    sheet          E.^. SheetCourse         E.==. cid
  | otherwise = E.false

isCourseExamCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseExamCorrector muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthExamCorrector = E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
    E.on $     examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
    E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val uid
      E.&&.    exam          E.^. ExamCourse        E.==. cid
  | otherwise = E.false

isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseParticipant muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthCourseRegistered = E.exists . E.from $ \courseParticipant -> E.where_ $ 
          courseParticipant E.^. CourseParticipantUser   E.==. E.val uid
    E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
    E.&&. courseParticipant E.^. CourseParticipantState  E.==. E.val CourseParticipantActive
    E.&&. E.val (authTagIsActive AuthCourseRegistered)
  | otherwise = E.false

isCourseApplicant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
isCourseApplicant muid AuthTagActive{..} cid maid
  | Just uid <- muid, authTagIsActive AuthApplicant = E.exists . E.from $ \courseApplication -> E.where_ $
          courseApplication E.^. CourseApplicationUser   E.==. E.val uid
    E.&&. courseApplication E.^. CourseApplicationCourse E.==. cid
    E.&&. E.maybe E.true
            (\aid -> E.just aid E.==. courseApplication E.^. CourseApplicationAllocation)
            maid
  | otherwise = E.false

isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
isCourseAssociated muid ata cid maid = 
        isCourseLecturer       muid ata cid
  E.||. isCourseTutor          muid ata cid
  E.||. isCourseSheetCorrector muid ata cid
  E.||. isCourseExamCorrector  muid ata cid
  E.||. isCourseParticipant    muid ata cid
  E.||. isCourseApplicant      muid ata cid maid


courseIsVisible :: UTCTime -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
courseIsVisible now course maid = 
  (E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (course E.^. CourseVisibleFrom)
    E.&&. E.maybe E.true (\visibleTo -> E.val now E.<=. visibleTo) (course E.^. CourseVisibleTo)
  ) E.||. courseAllocationRegistrationOpen now (course E.^. CourseId) maid

courseIsVisible' :: UTCTime -> Entity Course -> Maybe AllocationId -> E.SqlExpr (E.Value Bool)
courseIsVisible' now (Entity cid Course{..}) maid = 
        E.val (NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo)
  E.||. courseAllocationRegistrationOpen now (E.val cid) (E.val maid)
  where now' = NTop $ Just now


courseAllocationRegistrationOpen :: UTCTime -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value (Maybe AllocationId)) -> E.SqlExpr (E.Value Bool)
courseAllocationRegistrationOpen now cid maid = E.exists . E.from $ \(allocationCourse `E.InnerJoin` allocation) -> do
  E.on $ allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
  E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. cid
    E.&&. E.maybe
            E.true
            (\registerFrom -> registerFrom E.<=. E.val now)
            (allocation E.^. AllocationRegisterFrom)
    E.&&. E.maybe
            E.true
            (\registerTo   -> E.val now    E.<=. registerTo)
            (allocation E.^. AllocationRegisterTo)
    E.&&. E.maybe E.true (\aid -> aid E.==. allocation E.^. AllocationId) maid


numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)
numCourseParticipants cid = E.subSelectCount . E.from $ \courseParticipant ->
  E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. cid
       E.&&. courseParticipant E.^. CourseParticipantState  E.==. E.val CourseParticipantActive