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

module Handler.Course.Communication
  ( postCCommR, getCCommR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Communication

import qualified Database.Esqueleto.Legacy as E


getCCommR, postCCommR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCCommR = postCCommR
postCCommR tid ssh csh = do
  (cid, tuts, exams, sheets) <- runDB $ do
    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    tuts'' <- selectKeysList [TutorialCourse ==. cid] []
    tuts' <- forM tuts'' $ \tutid -> do
      cID <- encrypt tutid
      return ( RGTutorialParticipants cID
             , E.from $ \(user `E.InnerJoin` participant) -> do
                 E.on $ user E.^. UserId E.==. participant E.^. TutorialParticipantUser
                 E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
                 return user
             )
    let
      tuts | length tuts' < 2 = tuts'
           | otherwise  = ( RGCourseParticipantsInTutorial
                          , E.from $ \(user `E.InnerJoin` participant) -> do
                              E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
                              E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
                                   E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
                                   E.&&. (E.exists . E.from $ \tutParticipant -> E.where_ $
                                       tutParticipant E.^. TutorialParticipantUser E.==. user E.^. UserId
                                     )
                              return user
                          ) : tuts'

    exams' <- selectKeysList [ExamCourse ==. cid] []
    exams <- forM exams' $ \examid -> do
      cID <- encrypt examid
      return ( RGExamRegistered cID
             , E.from $ \(user `E.InnerJoin` examRegistration) -> do
                 E.on $ user E.^. UserId E.==. examRegistration E.^. ExamRegistrationUser
                 E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val examid
                 return user
             )

    sheets' <- selectKeysList [SheetCourse ==. cid] []
    sheets <- forM sheets' $ \sheetid -> do
      cID <- encrypt sheetid
      return ( RGSheetSubmittor cID
             , E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission) -> E.distinctOnOrderBy [E.asc $ user E.^. UserIdent] $ do
                 E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
                 E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
                 E.where_ $ submission E.^. SubmissionSheet E.==. E.val sheetid
                 return user
             )

    return (cid, tuts, exams, sheets)

  commR CommunicationRoute
    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
    , crUltDest    = SomeRoute $ CourseR tid ssh csh CCommR
    , crJobs       = crJobsCourseCommunication cid
    , crTestJobs   = crTestJobsCourseCommunication cid
    , crRecipients =
      [ ( RGCourseParticipants
        , E.from $ \(user `E.InnerJoin` participant) -> do
            E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
            E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
                 E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
            return user
        )
      , ( RGCourseLecturers
        , E.from $ \(user `E.InnerJoin` lecturer) -> do
            E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
            E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
            return user
        )
      , ( RGCourseTutors
        , E.from $ \user -> do
            E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
              E.on $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
              E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
                   E.&&. user E.^. UserId E.==. tutor E.^. TutorUser
            return user
        )
      , ( RGCourseCorrectors
        , E.from $ \user -> do
            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
                   E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
            return user
        )
      ] ++ tuts ++ exams ++ sheets
    , crRecipientAuth = Just $ \uid -> do
        cID <- encrypt uid
        evalAccessDB (CourseR tid ssh csh $ CUserR cID) False
    }