module Handler.Exam.Edit
  ( getEEditR, postEEditR
  ) where

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

import qualified Data.Set as Set

import Handler.Utils
import Handler.Utils.Exam
import Handler.Utils.Invitations

import Jobs.Queue


getEEditR, postEEditR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
getEEditR = postEEditR
postEEditR tid ssh csh examn = do
  (cid, Entity eId oldExam, template) <- runDB $ do
    (cid, exam) <- fetchCourseIdExam tid ssh csh examn

    template <- examFormTemplate exam

    return (cid, exam, template)

  ((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm validateExam . examForm $ Just template

  formResult editExamResult $ \ExamForm{..} -> do
    insertRes <- runDBJobs $ do
      insertRes <- myReplaceUnique eId Exam
        { examCourse           = cid
        , examName             = efName
        , examGradingRule      = efGradingRule
        , examBonusRule        = efBonusRule
        , examOccurrenceRule   = efOccurrenceRule
        , examVisibleFrom      = efVisibleFrom
        , examRegisterFrom     = efRegisterFrom
        , examRegisterTo       = efRegisterTo
        , examDeregisterUntil  = efDeregisterUntil
        , examPublishOccurrenceAssignments = efPublishOccurrenceAssignments
        , examStart            = efStart
        , examEnd              = efEnd
        , examFinished         = efFinished
        , examClosed           = examClosed oldExam
        , examPublicStatistics = efPublicStatistics
        , examShowGrades       = efShowGrades
        , examDescription      = efDescription
        }

      when (is _Nothing insertRes) $ do
        occIds <- fmap catMaybes . forM (Set.toList efOccurrences) $ traverse decrypt . eofId
        deleteWhere [ ExamOccurrenceExam ==. eId, ExamOccurrenceId /<-. occIds ]
        forM_ (Set.toList efOccurrences) $ \case
          ExamOccurrenceForm{ eofId = Nothing, .. } -> insert_
            ExamOccurrence
              { examOccurrenceExam = eId
              , examOccurrenceName = eofName
              , examOccurrenceRoom = eofRoom
              , examOccurrenceCapacity = eofCapacity
              , examOccurrenceStart = eofStart
              , examOccurrenceEnd = eofEnd
              , examOccurrenceDescription = eofDescription
              }
          ExamOccurrenceForm{ .. } -> void . runMaybeT $ do
            cID <- hoistMaybe eofId
            eofId' <- decrypt cID
            oldOcc <- MaybeT $ get eofId'
            guard $ examOccurrenceExam oldOcc == eId
            lift $ replace eofId' ExamOccurrence
              { examOccurrenceExam = eId
              , examOccurrenceName = eofName
              , examOccurrenceRoom = eofRoom
              , examOccurrenceCapacity = eofCapacity
              , examOccurrenceStart = eofStart
              , examOccurrenceEnd = eofEnd
              , examOccurrenceDescription = eofDescription
              }


        pIds <- fmap catMaybes . forM (Set.toList efExamParts) $ traverse decrypt . epfId
        deleteWhere [ ExamPartExam ==. eId, ExamPartId /<-. pIds ]
        forM_ (Set.toList efExamParts) $ \case
          ExamPartForm{ epfId = Nothing, .. } -> insert_
            ExamPart
              { examPartExam = eId
              , examPartNumber = epfNumber
              , examPartName = epfName
              , examPartMaxPoints = epfMaxPoints
              , examPartWeight = epfWeight
              }
          ExamPartForm{ .. } -> void . runMaybeT $ do
            cID <- hoistMaybe epfId
            epfId' <- decrypt cID
            oldPart <- MaybeT $ get epfId'
            guard $ examPartExam oldPart == eId
            lift $ replace epfId' ExamPart
              { examPartExam = eId
              , examPartNumber = epfNumber
              , examPartName = epfName
              , examPartMaxPoints = epfMaxPoints
              , examPartWeight = epfWeight
              }


        let (invites, adds) = partitionEithers $ Set.toList efCorrectors

        deleteWhere [ ExamCorrectorExam ==. eId ]
        insertMany_ $ map (ExamCorrector eId) adds

        deleteWhere [ InvitationFor ==. invRef @ExamCorrector eId, InvitationEmail /<-. invites ]
        sinkInvitationsF examCorrectorInvitationConfig $ map (, eId, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites

      return insertRes

    case insertRes of
      Just _  -> addMessageI Error $ MsgExamNameTaken efName
      Nothing -> do
        addMessageI Success $ MsgExamEdited efName
        redirect $ CExamR tid ssh csh efName EShowR

  let heading = prependCourseTitle tid ssh csh . MsgExamEditHeading $ efName template

  siteLayoutMsg heading $ do
    setTitleI heading
    let
      editExamForm = wrapForm editExamWidget def
        { formMethod = POST
        , formAction = Just . SomeRoute $ CExamR tid ssh csh examn EEditR
        , formEncoding = editExamEnctype
        }
    $(widgetFile "exam-edit")