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
  (template, (editExamAct, (editExamWidget, editExamEnctype))) <- runDBJobs $ do
    (cid, exam@(Entity eId oldExam)) <- fetchCourseIdExam tid ssh csh examn
    course <- getEntity404 cid

    template <- examFormTemplate exam

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

    editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
      insertRes <- myReplaceUnique eId Exam
        { examCourse           = cid
        , examName             = efName
        , examGradingRule      = efGradingRule
        , examBonusRule        = efBonusRule
        , examOccurrenceRule   = efOccurrenceRule
        , examExamOccurrenceMapping = examExamOccurrenceMapping oldExam
        , examVisibleFrom      = efVisibleFrom
        , examRegisterFrom     = efRegisterFrom
        , examRegisterTo       = efRegisterTo
        , examDeregisterUntil  = efDeregisterUntil
        , examPublishOccurrenceAssignments = efPublishOccurrenceAssignments
        , examStart            = efStart
        , examEnd              = efEnd
        , examFinished         = efFinished
        , examClosed           = examClosed oldExam
        , examPublicStatistics = efPublicStatistics
        , examGradingMode      = efGradingMode
        , examDescription      = efDescription
        , examExamMode         = efExamMode
        , examStaff            = efStaff
        , examPartsFrom        = efPartsFrom
        }

      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
              , examOccurrenceRoomHidden = eofRoomHidden
              , 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
              , examOccurrenceRoomHidden = eofRoomHidden
              , 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
              }

        deleteWhere [ ExamOfficeSchoolExam ==. eId ]
        insertMany_ [ ExamOfficeSchool ssh' eId | ssh' <- Set.toList efOfficeSchools ]

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

        deleteWhere [ ExamCorrectorExam ==. eId ]
        insertMany_ $ map (ExamCorrector eId) adds
        memcachedByInvalidate AuthCacheExamCorrectorList $ Proxy @(Set UserId)

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

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

    return (template, (editExamAct, (editExamWidget, editExamEnctype)))

  sequence_ editExamAct

  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")