-- 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.Exam.New
  ( getCExamNewR, postCExamNewR
  ) where

import Import
import Handler.Exam.Form
import Handler.Exam.CorrectorInvite

import qualified Data.Set as Set

import Handler.Utils
import Handler.Utils.Invitations

import Jobs.Queue

import qualified Data.Conduit.Combinators as C


getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCExamNewR = postCExamNewR
postCExamNewR tid ssh csh = do
  (newExamAct, (newExamWidget, newExamEnctype)) <- runDBJobs $ do
    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
    course <- getEntity404 cid
    template <- examTemplate cid

    ((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm course template

    newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
      now <- liftIO getCurrentTime

      examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement

      insertRes <- insertUnique Exam
        { examName                         = efName
        , examCourse                       = cid
        , examGradingRule                  = efGradingRule
        , examBonusRule                    = efBonusRule
        , examOccurrenceRule               = efOccurrenceRule
        , examExamOccurrenceMapping        = Nothing
        , examVisibleFrom                  = efVisibleFrom
        , examRegisterFrom                 = efRegisterFrom
        , examRegisterTo                   = efRegisterTo
        , examDeregisterUntil              = efDeregisterUntil
        , examPublishOccurrenceAssignments = efPublishOccurrenceAssignments
        , examStart                        = efStart
        , examEnd                          = efEnd
        , examFinished                     = efFinished
        , examClosed                       = Nothing
        , examGradingMode                  = efGradingMode
        , examPublicStatistics             = efPublicStatistics
        , examDescription                  = efDescription
        , examExamMode                     = efExamMode
        , examStaff                        = efStaff
        , examPartsFrom                    = efPartsFrom
        , examAuthorshipStatement
        }
      whenIsJust insertRes $ \examid -> do
        insertMany_
          [ ExamPart{..}
          | ExamPartForm{..} <- Set.toList efExamParts
          , let examPartExam      = examid
                examPartNumber    = epfNumber
                examPartName      = epfName
                examPartMaxPoints = epfMaxPoints
                examPartWeight    = epfWeight
          ]

        insertMany_
          [ ExamOccurrence{..}
          | ExamOccurrenceForm{..} <- Set.toList efOccurrences
          , let examOccurrenceExam        = examid
                examOccurrenceName        = eofName
                examOccurrenceRoom        = eofRoom
                examOccurrenceRoomHidden  = eofRoomHidden
                examOccurrenceCapacity    = eofCapacity
                examOccurrenceStart       = eofStart
                examOccurrenceEnd         = eofEnd
                examOccurrenceDescription = eofDescription
          ]

        insertMany_ [ ExamOfficeSchool ssh' examid | ssh' <- Set.toList efOfficeSchools ]

        let (invites, adds) = partitionEithers $ Set.toList efCorrectors
        insertMany_ [ ExamCorrector{..}
                    | let examCorrectorExam = examid
                    , examCorrectorUser <- adds
                    ]
        sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
        memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)

        let recordNoShow (Entity _ CourseParticipant{..}) = do
              didRecord <- is _Just <$> insertUnique ExamResult
                { examResultExam = examid
                , examResultUser = courseParticipantUser
                , examResultResult = ExamNoShow
                , examResultLastChanged = now
                }
              when didRecord $
                audit $ TransactionExamResultEdit examid courseParticipantUser
        runConduit $ selectSource [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantInactive True ] [] .| C.mapM_ recordNoShow

      return . Just $ case insertRes of
        Nothing -> addMessageI Error $ MsgExamEditExamNameTaken efName
        Just _  -> do
          addMessageI Success $ MsgExamCreated efName
          redirect $ CourseR tid ssh csh CExamListR

    return (newExamAct, (newExamWidget, newExamEnctype))

  sequence_ newExamAct

  let heading = prependCourseTitle tid ssh csh MsgExamNew

  siteLayoutMsg heading $ do
    setTitleI heading
    let
      newExamForm = wrapForm newExamWidget def
        { formMethod = POST
        , formAction = Just . SomeRoute $ CourseR tid ssh csh CExamNewR
        , formEncoding = newExamEnctype
        }
    $(widgetFile "exam-new")