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

{-# LANGUAGE TypeApplications #-}

module Handler.Utils.Course where

import Import
import Handler.Utils.Delete
import Handler.Utils.Memcached

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E
import           Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma

import qualified Data.Set as Set


courseDeleteRoute :: Set CourseId -> DeleteRoute Course
courseDeleteRoute drRecords = DeleteRoute
  { drRecords
  , drGetInfo = \(course `E.InnerJoin` school) -> do
      E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
      E.orderBy [E.asc $ course E.^. CourseName]
      return (course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
  , drUnjoin = \(course `E.InnerJoin` _) -> course
  , drRenderRecord = \(E.Value cName, _, E.Value sName, E.Value tid') ->
      return [whamlet|
        #{cName} (_{ShortTermIdentifier (unTermKey tid')}, #{sName})
      |]
  , drRecordConfirmString = \(E.Value cName, E.Value ssh', _, E.Value tid') ->
      return [st|#{termToText (unTermKey tid')}/#{ssh'}/#{cName}|]
  , drCaption = SomeMessage MsgCourseDeleteQuestion
  , drSuccessMessage = SomeMessage MsgCourseDeleted
  , drFormMessage = const $ return Nothing
  , drAbort = error "drAbort undefined"
  , drSuccess = error "drSuccess undefined"
  , drDelete = const id  -- TODO: audit
  }

setUserSubmissionGroup :: ( MonadHandler m
                          , HandlerSite m ~ UniWorX
                          , backend ~ SqlBackend
                          , MonadCatch m
                          ) => CourseId -> UserId -> Maybe SubmissionGroupName -> ReaderT backend m Bool
setUserSubmissionGroup cid uid = fmap (> 0) . setUsersSubmissionGroup cid (Set.singleton uid)

setUsersSubmissionGroup :: ( MonadHandler m
                           , HandlerSite m ~ UniWorX
                           , backend ~ SqlBackend
                           , MonadCatch m
                           ) => CourseId -> Set UserId -> Maybe SubmissionGroupName -> ReaderT backend m Int64
setUsersSubmissionGroup cid uids Nothing = do
  didDelete <- fmap getSum . flip foldMapM uids $ \uid -> do
    didDelete <- fmap (> 0) . E.deleteCount . E.from $ \submissionGroupUser ->
      E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
           E.&&. E.subSelectForeign submissionGroupUser SubmissionGroupUserSubmissionGroup (E.^. SubmissionGroupCourse) E.==. E.val cid
    when didDelete $ do
      audit $ TransactionSubmissionGroupUnset cid uid
      memcachedByInvalidate AuthCacheSubmissionGroupUserList (Proxy @(Set UserId))
    return $ bool mempty (Sum 1) didDelete
  E.delete . E.from $ \submissionGroup ->
    E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
         E.&&. E.not_ (E.exists . E.from $ \submissionGroupUser -> E.where_ $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId)
  return didDelete
setUsersSubmissionGroup cid uids (Just grp) = do
  Entity gId _ <- upsert (SubmissionGroup cid grp) [ SubmissionGroupName =. grp ]

  E.delete . E.from $ \submissionGroupUser ->
    E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser `E.in_` E.valList (Set.toList uids)
         E.&&. E.subSelectForeign submissionGroupUser SubmissionGroupUserSubmissionGroup (E.^. SubmissionGroupCourse) E.==. E.val cid
         E.&&. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.!=. E.val gId
  E.delete . E.from $ \submissionGroup ->
    E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
         E.&&. E.not_ (E.exists . E.from $ \submissionGroupUser -> E.where_ $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId)
         E.&&. submissionGroup E.^. SubmissionGroupId E.!=. E.val gId
  fmap getSum . flip foldMapM uids $ \uid -> do
    didSet <- fmap (is _Just) . insertUnique $ SubmissionGroupUser gId uid
    when didSet $ do
      audit $ TransactionSubmissionGroupSet cid uid grp
      memcachedByInvalidate AuthCacheSubmissionGroupUserList (Proxy @(Set UserId))
    return $ bool mempty (Sum 1) didSet

showCourseEventRoom :: forall courseEvent courseId.
                       E.SqlProject CourseEvent CourseId courseEvent courseId
                    => E.SqlExpr (E.Value UserId) -> E.SqlExpr courseEvent -> E.SqlExpr (E.Value Bool)
showCourseEventRoom uid courseEvent = E.or
  [ E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
      E.on $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
      E.where_ $ tutor E.^. TutorUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (tutorial E.^. TutorialCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse
  , E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
      E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
      E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (sheet E.^. SheetCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse
  , E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
      E.on $ exam E.^. ExamId E.==. examCorrector E.^. ExamCorrectorExam
      E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (exam E.^. ExamCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse
  , E.exists . E.from $ \courseParticipant ->
      E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
           E.&&. courseParticipant E.^. CourseParticipantUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (courseParticipant E.^. CourseParticipantCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse
  , E.exists . E.from $ \lecturer ->
      E.where_ $ lecturer E.^. LecturerUser E.==. uid
           E.&&. E.unSqlProjectExpr (Proxy @CourseEvent) (Proxy @courseEvent) (lecturer E.^. LecturerCourse) E.==. courseEvent `E.sqlProject` CourseEventCourse
  ]

getCourseQualifications :: ( MonadHandler m
                           , backend ~ SqlBackend
                           )
                        => CourseId -> ReaderT backend m [Entity Qualification]
getCourseQualifications cid = Ex.select $ do
  (qual :& courseQual) <-
    Ex.from $      Ex.table @Qualification
    `Ex.innerJoin` Ex.table @CourseQualification
    `Ex.on` (\(qual :& courseQual) -> qual E.^. QualificationId E.==. courseQual E.^. CourseQualificationQualification)
  Ex.where_ $ courseQual E.^. CourseQualificationCourse E.==. E.val cid
  Ex.orderBy [E.asc $ courseQual E.^. CourseQualificationSortOrder, E.asc $ qual E.^. QualificationName]
  pure qual