fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: have exam deregistration always delete stored grades

Browse Source
This commit is contained in:
Gregor Kleen 2020-08-26 16:03:54 +02:00
parent f8ec31eaa8
commit 24f428b13b
5 changed files with 46 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Handler/Course/Register.hs
View File

@ -9,6 +9,7 @@ module Handler.Course.Register
import Import
import Handler.Utils
import Handler.Utils.Exam
import Utils.Course
@ -297,9 +298,8 @@ deregisterParticipant uid cid = do
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
return examRegistration
forM_ examRegistrations $ \(Entity erId ExamRegistration{..}) -> do
delete erId
audit $ TransactionExamDeregister examRegistrationExam uid
forM_ examRegistrations $ \(Entity _ ExamRegistration{..}) -> do
deregisterExamUsers examRegistrationExam $ pure examRegistrationUser
E.delete . E.from $ \tutorialParticipant -> do
let tutorialCourse = E.subSelectForeign tutorialParticipant TutorialParticipantTutorial (E.^. TutorialCourse)

4
src/Handler/Exam/Show.hs
View File

@ -124,6 +124,7 @@ getEShowR tid ssh csh examn = do
, mayRegister' (entityKey <$> mOcc) = Just $ do
(examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
[whamlet|
$newline never
<p>
$if isRegistered
_{MsgExamRegistered}
@ -147,11 +148,12 @@ getEShowR tid ssh csh examn = do
}
| is _Nothing mOcc
, is _Nothing registered
= Just [whamlet|_{MsgExamLoginToRegister}|]
= Just $ i18n MsgExamLoginToRegister
| is _Nothing mOcc
, isRegistered <- is _Just $ join registered
= Just
[whamlet|
$newline never
<p>
$if isRegistered
_{MsgExamRegistered}

18
src/Handler/Exam/Users.hs
View File

@ -36,7 +36,7 @@ import qualified Data.CaseInsensitive as CI
import Numeric.Lens (integral)
import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
import Database.Persist.Sql (updateWhereCount)
import Control.Lens.Indexed ((<.), (.>))
@ -840,13 +840,8 @@ postEUsersR tid ssh csh examn = do
]
audit $ TransactionExamResultEdit eid examUserCsvActUser
ExamUserCsvDeregisterData{..} -> do
ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration
audit $ TransactionExamDeregister eid examRegistrationUser
delete examUserCsvActRegistration
result <- getBy $ UniqueExamResult eid examRegistrationUser
forM_ result $ \(Entity erId _) -> do
delete erId
audit $ TransactionExamResultDeleted eid examRegistrationUser
ExamRegistration{..} <- getJust examUserCsvActRegistration
deregisterExamUsers examRegistrationExam $ pure examRegistrationUser
ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do
noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse
whenIsJust noteId $ \nid -> do
@ -1051,10 +1046,9 @@ postEUsersR tid ssh csh examn = do
(, exam, bonus) . over (_1 . _2) postprocess <$> dbTable examUsersDBTableValidator examUsersDBTable
formResult registrationResult $ \case
(ExamUserDeregisterData, Map.keysSet -> selectedRegistrations) -> do
nrDel <- runDB $ deleteWhereCount
[ ExamRegistrationId <-. Set.toList selectedRegistrations
]
(ExamUserDeregisterData, Map.elems -> selectedRegistrations) -> do
nrDel <- runDB . setSerializable . deregisterExamUsersCount eId $ map (view $ resultUser . _entityKey) selectedRegistrations
addMessageI Success $ MsgExamUsersDeregistered nrDel
redirect $ CExamR tid ssh csh examn EUsersR
(ExamUserAssignOccurrenceData occId, Map.keysSet -> selectedRegistrations) -> do

32
src/Handler/Utils/Exam.hs
View File

@ -10,6 +10,7 @@ module Handler.Utils.Exam
, eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize
, _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
, examAutoOccurrence
, deregisterExamUsersCount, deregisterExamUsers
) where
import Import
@ -609,3 +610,34 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
in Set.map (appEndo $ foldMap Endo [ over l padSuff | l <- [_eaomrStart, _eaomrEnd, _eaomrSpecial]]) <$> res
| otherwise
= res
deregisterExamUsersCount :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m Int64
deregisterExamUsersCount eId uids = do
partResults <- E.select . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do
E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart
E.where_ $ examPart E.^. ExamPartExam E.==. E.val eId
E.&&. examPartResult E.^. ExamPartResultUser `E.in_` E.valList uids
return examPartResult
forM_ partResults $ \(Entity resId ExamPartResult{..}) -> do
delete resId
audit $ TransactionExamPartResultDeleted examPartResultExamPart examPartResultUser
results <- selectList [ ExamResultExam ==. eId, ExamResultUser <-. uids ] []
forM_ results $ \(Entity resId ExamResult{..}) -> do
delete resId
audit $ TransactionExamResultDeleted examResultExam examResultUser
boni <- selectList [ ExamBonusExam ==. eId, ExamBonusUser <-. uids ] []
forM_ boni $ \(Entity bonusId ExamBonus{..}) -> do
delete bonusId
audit $ TransactionExamBonusDeleted examBonusExam examBonusUser
regs <- selectList [ ExamRegistrationExam ==. eId, ExamRegistrationUser <-. uids ] []
fmap (ala Sum foldMap) . forM regs $ \(Entity regId ExamRegistration{..}) -> do
delete regId
audit $ TransactionExamDeregister examRegistrationExam examRegistrationUser
return 1
deregisterExamUsers :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m ()
deregisterExamUsers eId uids = void $ deregisterExamUsersCount eId uids

4
templates/exam-show.hamlet
View File

@ -87,8 +87,8 @@ $maybe desc <- examDescription
$maybe registerWdgt <- registerWidget Nothing
<dt .deflist__dt>
_{MsgExamRegistration}
\ ^{isVisible False}
<dd .deflist__dd>^{registerWdgt}
<dd .deflist__dd>
^{registerWdgt}
$if showCloseWidget && is _Nothing examClosed
<section>