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 as E
import qualified Database.Esqueleto.Utils as E


mayViewCourse :: Maybe UserId -> AuthTagActive -> UTCTime -> E.SqlExpr (Entity Course) -> Maybe (E.SqlExpr (E.Value 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 = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
  E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
  E.where_ $ E.just (user E.^. UserId)           E.==. E.val muid
    E.&&. userFunction E.^. UserFunctionSchool   E.==. ssh
    E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
    E.&&. E.val (authTagIsActive AuthAdmin)

-- TODO: find better name
isSchoolAdminLike :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdminLike muid ata@AuthTagActive{..} ssh = 
        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_ $ E.just (user E.^. UserId) E.==. E.val muid
      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))
      )
    )

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

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

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

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

isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseParticipant muid AuthTagActive{..} cid = E.exists . E.from $ \courseParticipant -> E.where_ $ 
        E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
  E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
  E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
  E.&&. E.val (authTagIsActive AuthCourseRegistered)  -- TODO is this the auth tag I want here?

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

isCourseAssociated :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> Maybe (E.SqlExpr (E.Value 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) -> Maybe (E.SqlExpr (E.Value AllocationId)) -> E.SqlExpr (E.Value Bool)
courseIsVisible now course maid = 
  (E.maybe (E.val False) (\visibleFrom -> visibleFrom E.<=. E.val now) (course E.^. CourseVisibleFrom)
    E.&&. E.maybe (E.val 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) -> Maybe (E.SqlExpr (E.Value 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.val False)
            (\registerFrom -> registerFrom E.<=. E.val now)
            (allocation E.^. AllocationRegisterFrom)
    E.&&. E.maybe
            (E.val True)
            (\registerTo   -> E.val now    E.<=. registerTo)
            (allocation E.^. AllocationRegisterTo)
    E.&&. maybe (E.val 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