104 lines
4.1 KiB
Haskell
104 lines
4.1 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.ExternalExam.Edit
|
|
( getEEEditR, postEEEditR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Invitations
|
|
|
|
import Handler.ExternalExam.Form
|
|
import Handler.ExternalExam.StaffInvite
|
|
|
|
import qualified Data.Set as Set
|
|
import qualified Data.Map as Map
|
|
|
|
import Jobs.Queue
|
|
|
|
|
|
getEEEditR, postEEEditR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
|
getEEEditR = postEEEditR
|
|
postEEEditR tid ssh coursen examn = do
|
|
(Entity eeId ExternalExam{..}, schools, staff) <- runDB $ do
|
|
eExam@(Entity eeId _) <- getBy404 $ UniqueExternalExam tid ssh coursen examn
|
|
schools <- setOf (folded . _entityVal . _externalExamOfficeSchoolSchool) <$> selectList [ ExternalExamOfficeSchoolExam ==. eeId ] []
|
|
actualStaff <- selectList [ ExternalExamStaffExam ==. eeId ] []
|
|
invitedStaff <- sourceInvitationsF @ExternalExamStaff eeId
|
|
let staff = setOf (folded . _entityVal . _externalExamStaffUser . re _Right) actualStaff
|
|
<> Set.mapMonotonic Left (Map.keysSet invitedStaff)
|
|
return (eExam, schools, staff)
|
|
|
|
let
|
|
template = ExternalExamForm
|
|
{ eefTerm = tid
|
|
, eefSchool = ssh
|
|
, eefCourseName = coursen
|
|
, eefExamName = examn
|
|
, eefDefaultTime = externalExamDefaultTime
|
|
, eefGradingMode = externalExamGradingMode
|
|
, eefOfficeSchools = schools
|
|
, eefStaff = staff
|
|
}
|
|
|
|
((examResult, examWidget'), examEnctype) <- runFormPost . externalExamForm $ Just template
|
|
|
|
formResult examResult $ \ExternalExamForm{..} -> do
|
|
replaceRes <- runDBJobs $ do
|
|
replaceRes <- replaceUnique eeId ExternalExam
|
|
{ externalExamTerm = eefTerm
|
|
, externalExamSchool = eefSchool
|
|
, externalExamCourseName = eefCourseName
|
|
, externalExamExamName = eefExamName
|
|
, externalExamDefaultTime = eefDefaultTime
|
|
, externalExamGradingMode = eefGradingMode
|
|
}
|
|
when (is _Nothing replaceRes) $ do
|
|
audit $ TransactionExternalExamEdit eeId
|
|
|
|
memcachedByInvalidate AuthCacheExternalExamStaffList $ Proxy @(Set UserId)
|
|
forM_ (eefStaff `setSymmDiff` staff) $ \change -> if
|
|
| change `Set.member` eefStaff -> case change of
|
|
Left invEmail -> do
|
|
audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
|
|
sinkInvitationsF externalExamStaffInvitationConfig
|
|
[(invEmail, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff))]
|
|
Right staffUid -> do
|
|
audit $ TransactionExternalExamStaffEdit eeId staffUid
|
|
insert_ $ ExternalExamStaff staffUid eeId
|
|
| otherwise -> case change of
|
|
Left invEmail -> do
|
|
audit $ TransactionExternalExamStaffInviteDelete eeId invEmail
|
|
deleteInvitation @ExternalExamStaff eeId invEmail
|
|
Right staffUid -> do
|
|
audit $ TransactionExternalExamStaffDelete eeId staffUid
|
|
deleteBy $ UniqueExternalExamStaff eeId staffUid
|
|
|
|
forM_ (eefOfficeSchools `setSymmDiff` schools) $ \change -> if
|
|
| change `Set.member` eefOfficeSchools -> do
|
|
audit $ TransactionExternalExamOfficeSchoolEdit eeId change
|
|
insert_ $ ExternalExamOfficeSchool change eeId
|
|
| otherwise -> do
|
|
audit $ TransactionExternalExamOfficeSchoolDelete eeId change
|
|
deleteBy $ UniqueExternalExamOfficeSchool eeId change
|
|
return replaceRes
|
|
|
|
case replaceRes of
|
|
Nothing -> do
|
|
addMessageI Success $ MsgExternalExamEdited eefCourseName eefExamName
|
|
redirect $ EExamR eefTerm eefSchool eefCourseName eefExamName EEShowR
|
|
Just _ ->
|
|
addMessageI Error $ MsgExternalExamExists eefCourseName eefExamName
|
|
|
|
let heading = MsgExternalExamEdit coursen examn
|
|
|
|
siteLayoutMsg heading $ do
|
|
setTitleI heading
|
|
wrapForm examWidget' def
|
|
{ formAction = Just . SomeRoute $ EExamR tid ssh coursen examn EEEditR
|
|
, formEncoding = examEnctype
|
|
}
|